Maheshp
01-12-2018, 09:34 AM
I have table (Row:10, column:2) in word document, 2nd column of row 10, contain text with bullet points,
again under some 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)
• College ABC JJJJ
• College XYZ JJJJ
(i) Debit USD 1000 for ZZZ
(ii) Debit USD 56 for MNN
(iii) Location - USA
• College NNN JJJJ
I will appreciate any assistance to edit below 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
again under some 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)
• College ABC JJJJ
• College XYZ JJJJ
(i) Debit USD 1000 for ZZZ
(ii) Debit USD 56 for MNN
(iii) Location - USA
• College NNN JJJJ
I will appreciate any assistance to edit below 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