CODEWITHSUNDEEP
vbams-word
user3096589
user3096589

Reputation: 21

Need VBA script to concatenate 2 lines in MS Word

Every week I get a large MS Word file that needs some simple formatting. I need to look for a Bible book name on a line by itself and it ends with a carriage return and then concatenate this line with the next line. Like this:

I need to put my cursor at the end of "Gen." add a space and hit the delete key to make it look like this:

If "Gen." appears anywhere else in the document (other than the only text on the line) I need to leave it alone. I need to search each line of the entire document looking for 5 books, "Gen.", "Exo.", "Lev.", "Num.", "Deut." (in the end I will need to look for 66 books). I have been working on a VBA script (getting help from this site) to do this with no success. It seems like it should be relatively simple, but I have not been able to get it to work. My poor attempt is below. Any help would be greatly appreciated.

    Public Sub ConCatVerses()

     Selection.HomeKey Unit:=wdStory

     For Each line_in_para In ActiveDocument.Paragraphs

     text_in_line = line_in_para.Range.Text

     If InStr(text_in_line, "Gen.") Then
       Selection.HomeKey Unit:=wdLine
       Selection.EndKey Unit:=wdLine
       Selection.Delete Unit:=wdCharacter, Count:=1
       Selection.TypeText Text:=" "
       Selection.MoveDown Unit:=wdLine, Count:=1
     End If

      Next line_in_para

   End Sub

Thanks for the help. I took your suggestion and added the other elements I needed. Hopefully someone will get some help from this working code. Now this one VBA script will go through the entire document and make the necessary changes.

    Sub ConCatVerses1()
    '
    ' Concatenate 2 lines
    '
    '
    Dim myArray1, myArray2 As Variant
    Dim x As Integer

    myArray1 = Array("Gen.^p", "Exo.^p", "Lev.^p", "Num.^p", "Deut.^p")
    myArray2 = Array("Gen. ", "Exo. ", "Lev. ", "Num. ", "Deut. ")


    For x = LBound(myArray1) To UBound(myArray1)

    BKNAMEF = myArray1(x)
    BKNAMER = myArray2(x)

    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
     .Text = BKNAMEF
     .Replacement.Text = BKNAMER
     .Forward = True
     .Wrap = wdFindContinue
     .Format = False
     .MatchCase = False
     .MatchWholeWord = False
     .MatchWildcards = False
     .MatchSoundsLike = False
     .MatchAllWordForms = False
     End With
     Selection.Find.Execute Replace:=wdReplaceAll

     Next x

  End Sub

Upvotes: 0

Views: 888

Answers (1)

Peekay
Peekay

Reputation: 236

You may actually not need any VBA. Try Finding "Gen.^p" and replace with "Gen. ". This should work. If Gen. line contains Gen. + " " (space) you may have to Find "Gen. ^p". ^p is the carriage return character. I placed quotes "" for you to understand the exact strings. You will need to remove it when you do Find Replace.

Upvotes: 0

Related Questions