Word VBA_find string against bullet point

**Mahesh** · 01-06-2018, 12:18 PM

I have table (Row:10, column:2) in word document, 2nd column of row 10, contain text with bullet points,
again undersome bullet point there is multilevel lists as mentioned below.

Steps;
1. create new excel document (wb2)
2. Go back to main word file (wb1) with table (Row:10,Col:2)
3. Pop Up InputBox, user will input search string "ABC"
4. search text "ABC" against bullet point if found copy on (wb2- column A)
5. If again there is multilevel list under bullet point
6. search "USD" if found copy USD amount to (wb2 - column B)
7. search "Location" if found Location to (wb2 - column C)

i do post here also.
http://www.excelforum.com/word-forma...?20-Word-Help]

I will appreciate any assistance to edit below code;

Code:

Sub test() 
    Dim TargetText As String, StrMsg As String 
    Dim Col As Long, i As Long, j As Long, Rng As Range 
    With Selection 
        If .Information(wdWithInTable) = False Then 
            MsgBox "The cursor must be within a table cell.", , "Cursor outside table" 
            Exit Sub 
        Else 
            Col = .Cells(1).ColumnIndex 
            TargetText = InputBox("Enter text to search. " & _ 
            "This macro will search the column you have " & _ 
            "selected for this text and count how many " & _ 
            "times it appears in that column. Do you want to continue?", _ 
            "Enter text to find and count") 
            With .Tables(1) 
                For i = 1 To .Rows.Count 
                    Set Rng = .Cell(i, Col).Range 
                    With .Cell(i, Col).Range 
                         
                        With .Find 
                            .ClearFormatting 
                            .Text = TargetText 
                             '.Replacement.ClearFormatting ''Clear existing formatting and settings in Find feature.
                            .Replacement.Highlight = True 'Set highlight to replace setting.
                            .Replacement.Text = "" 
                             '.Replacement.
                            .Forward = True 
                            .Wrap = wdFindStop 
                            .Format = True 
                            .MatchCase = False 
                            .MatchWholeWord = True 
                            .MatchWildcards = False 
                            .MatchSoundsLike = False 
                            .MatchAllWordForms = False 
                            .Execute Replace:=wdReplaceAll 
                        End With 
                         
                         
                        Do While .Find.Found 
                            If .Duplicate.InRange(Rng) Then 
                                j = j + 1 
                                .Collapse wdCollapseEnd 
                                .Find.Execute 
                            Else 
                                Exit Do 
                            End If 
                        Loop 
                    End With 
                Next 
            End With 
            Select Case j 
            Case 0: StrMsg = "The text " & TargetText & " was not found in the selected column " 
            Case 1: StrMsg = "There is 1 occurrence of the text " & TargetText & " in the selected column " 
            Case Else: StrMsg = "There are " & j & " occurrences of the text '" & TargetText & "' in the selected column " 
            End Select 
            MsgBox StrMsg & Col & ".", , "Text search in column" 
        End If 
    End With 
End Sub