View Single Post
 
Old 07-17-2019, 03:28 PM
gmaxey gmaxey is offline Windows 10 Office 2016
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,598
gmaxey is just really nicegmaxey is just really nicegmaxey is just really nicegmaxey is just really nicegmaxey is just really nice
Default

Graham is on the other side of the world and it will be awhile before he is back around. Based on your example scenario, I am assuming that the terms e.g., PSA will appear once in the text to process.

The following might work were you define the number of following words to include in your term definition table. See attached:

Code:
Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oTbl As Table
Dim arrTerm() As String
Dim lngIndex As Long
Dim oRng As Range

  Set oTbl = ActiveDocument.Tables(1)
  ReDim arrTerm(oTbl.Rows.Count - 2, 1)
  For lngIndex = 2 To oTbl.Rows.Count
    arrTerm(lngIndex - 2, 0) = fcnGetCellText(oTbl.Cell(lngIndex, 1))
    arrTerm(lngIndex - 2, 1) = fcnGetCellText(oTbl.Cell(lngIndex, 2))
  Next lngIndex
  For lngIndex = 0 To UBound(arrTerm, 1)
    Set oRng = ActiveDocument.Range
    oRng.Start = oTbl.Range.End
    With oRng.Find
      .Text = arrTerm(lngIndex, 0)
      If .Execute Then
         Select Case True
           Case IsNumeric(arrTerm(lngIndex, 1))
              oRng.Collapse wdCollapseEnd
              oRng.MoveEnd wdWord, Val(arrTerm(lngIndex, 1)) + 1
              oTbl.Cell(lngIndex + 2, 3).Range.Text = Trim(oRng.Text)
           Case arrTerm(lngIndex, 1) = "T/F"
             oTbl.Cell(lngIndex + 2, 3).Range.Text = "True"
         End Select
      Else
        Select Case True
           Case IsNumeric(arrTerm(lngIndex, 1))
             oTbl.Cell(lngIndex + 2, 3).Range.Text = vbNullString
           Case arrTerm(lngIndex, 1) = "T/F"
             oTbl.Cell(lngIndex + 2, 3).Range.Text = "False"
         End Select
      End If
    End With
  Next lngIndex
lbl_Exit:
  Exit Sub
  
End Sub
Function fcnGetCellText(oCell As Cell) As String
  fcnGetCellText = Left(oCell.Range.Text, Len(oCell.Range.Text) - 2)
lbl_Exit:
  Exit Function
End Function
Attached Files
File Type: docx keyword search example.docx (13.8 KB, 11 views)
File Type: docm keyword search example.docm (19.4 KB, 11 views)
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote