Microsoft Office Forums - View Single Post - [Solved] Count occurences of 2 words (that are near each other)

Guessed · 02-06-2020, 05:32 AM

To resolve the order issue and allow the proximity to be measured in words rather characters the code needs to be hit the first word and then search backwards and forwards for the partner word.

Code:

Sub CountProx()
  Dim i As Integer, s1 As String, s2 As String, iWd As Long, aRng As Range, iProx As Integer
  Dim iWds As Long, iDocWordCount As Long, iStart As Long, iEnd As Long
  
  s1 = "word"
  s2 = "flash"
  iProx = 10
  
  Set aRng = ActiveDocument.Range
  iDocWordCount = ActiveDocument.Range.Words.Count
  
  With aRng.Find
    .ClearFormatting
    .Text = s1
    .Forward = True
    .MatchCase = False
    .MatchWholeWord = True
    .Wrap = wdFindStop
    .MatchWildcards = False
    .Execute
    Do While .Found
      iWd = ActiveDocument.Range(0, aRng.Start).Words.Count
      iStart = iWd - iProx
      If iStart < 1 Then iStart = 1
      iEnd = iWd + iProx
      If iEnd > iDocWordCount Then iEnd = iDocWordCount
      For i = iStart To iEnd
        If LCase(Trim(ActiveDocument.Words(i).Text)) = s2 Then
          iWds = iWds + 1
        End If
      Next i
      aRng.Collapse wdCollapseEnd
      .Execute
    Loop
  End With
  MsgBox "Pairs in Proximity: " & iWds

End Sub