CODEWITHSUNDEEP
vbams-word
Stephen
Stephen

Reputation: 3

Set selected text as string and search for string in a range

I have two tables in a Word document.

I want to search Column2 of Table1 (located in one range) for the text "yes" and, if found, select the text in the cell to the left ("John" in the example below).
Once that text is selected I want to set that as a string so that I can search Table2 (located in a second range).

Once the string is found in Table2 I want to navigate to the last column in the row and copy the text inside.
I want to paste the text in the Table1 cell that contains the original "yes" text that was searched for.
I want this to be looped to replace further "yes" text on rows after so that Table1 becomes New Table1 below:

Table1:

Name. Column2
John. Yes
Jill. -
Jane. Yes

Table2:

Name. Column2 Column 3 Column4
John. copytext1
Jill.
Jane. copytext2

New Table1:

Name. Column2
John. copytext1
Jill.
Jane. copytext2

I've written VBA code that pastes the last copied text previous to running the macro instead of the text copied from column4.
I tried running the code in parts but it only works when I replace the string with actual text (part 4).

Sub ReplaceYesWithCopyText()

Set oRng = ActiveDocument.Range
oRng.Start = oRng.Bookmarks("Bookmark1").Range.End
oRng.End = oRng.Bookmarks("Bookmark2").Range.Start

Dim str1 As String
Dim tbl As Table, r As Long
Set tbl = oRng.Tables(1)

For r = 1 To tbl.Rows.Count
    tbl.Cell(r, 3).Range.Select

    Set Rng = Selection.Range
    With Rng.Find
        .ClearFormatting
        .Font.Bold = True
            
'1. Search for yes in row 1 of column three
        .Execute FindText:="Yes", Format:=True, Forward:=True
        If .Found = True Then
                    
'2. Set cell to left as string
            tbl.Cell(r, 2).Range.Select
            str1 = Selection.Paragraphs(1).Range.Text
                    
'3. Set second range to search table 2
            Set oRng = ActiveDocument.Range
            oRng.Start = oRng.Bookmarks("Bookmark3").Range.End
            oRng.End = oRng.Bookmarks("Bookmark4").Range.Start
            oRng.Tables(1).Select
            Dim Fnd As Boolean
        
'4. Find name/string in tabke two
            Set Rng = Selection.Range
            With Rng.Find
                .ClearFormatting
                .Execute FindText:=str1, Forward:=True, _
                Format:=False, Wrap:=wdFindStop
                Fnd = .Found
            End With
        
'5. Navigating to colum 4 and copying cell text
            If Fnd = True Then
                With Rng
                   Selection.EndKey Unit:=wdLine
                    Selection.EndKey Unit:=wdLine
                    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
                    'str2 = Selection.Paragraphs(1).Range.Text
                    Selection.Copy
                End With
            End If
                            
'6. Set range back to table 1
            Set oRng = ActiveDocument.Range
            oRng.Start = oRng.Bookmarks("Bookmark1").Range.End
            oRng.End = oRng.Bookmarks("Bookmark2").Range.Start

'7. Find Yes in orginal column and paste info
            tbl.Cell(r, 3).Range.Select
            Selection.Paste
        End If
    End With
    Set Rng = Nothing
Next r

End Sub

Upvotes: 0

Views: 296

Answers (1)

macropod
macropod

Reputation: 13490

For example:

Sub Demo()
Application.ScreenUpdating = False
Dim Tbl1 As Table, Tbl2 As Table, Rng1 As Range, Rng2 As Range, r As Long
With ActiveDocument
  Set Tbl1 = .Tables(1): Set Tbl2 = .Tables(2): Set Rng1 = .Tables(1).Range
  With Tbl1.Range
    With .Find
      .ClearFormatting
      .Forward = True
      .Wrap = wdFindStop
      .Format = False
      .MatchCase = True
      .MatchWholeWord = True
      .MatchWildcards = False
      .Text = "Yes"
      .Replacement.Text = ""
    End With
    Do While .Find.Execute = True
      If .InRange(Rng1) = False Then Exit Sub
      If .Cells(1).ColumnIndex = 2 Then
        r = .Cells(1).RowIndex
        Set Rng2 = Rng1.Tables(1).Cell(r, 1).Range: Rng2.End = Rng2.End - 1
        With Tbl2.Range
          With .Find
            .Text = Rng2.Text
            .Wrap = wdFindStop
            .Execute
          End With
          If .Find.Found = True Then
            Set Rng2 = Tbl2.Cell(.Cells(1).RowIndex, .Rows(1).Cells.Count).Range
            Rng2.End = Rng2.End - 1
            Rng1.Tables(1).Cell(r, 1).Range.FormattedText = Rng2.FormattedText
          End If
        End With
      End If
      .Collapse (wdCollapseEnd)
    Loop
  End With
End With
Application.ScreenUpdating = True
End Sub

Upvotes: 0

Related Questions