title: Expanding a range in VBA
body: <p>I am in the process of putting together a Word macro (below) that parses a table of acronyms in one Word document and highlights every occurrence of these acronyms in another Word document. This appears to be functional.</p>
  
  <p>However, I would like to also have the macro differentiate acronyms that are in parentheses from those that are not. For example,</p>
  
  <p>The soldier is considered Away Without Leave (AWOL).  AWOL personnel are subject to arrest.</p>
  
  <p>It seems as though the range "oRange" that defines the found acronym could be evaluated, if it is first expanded in the Do-While loop using this code: </p>
  
  <p>oRange.SetRange Start:=oRange.Start - 1, End:=oRange.End + 1 </p>
  
  <p>However, none of my attempts to code a solution seem to work (they put the macro into an infinite loop or result in error messages). I'm fairly new to VBA programming and am obviously missing something regarding how the loops are operating.</p>
  
  <p>My question is: is there a way to duplicate the range "oRange" for subsequent manipulation or is there some other method that I should be using?</p>
  
  <p>Thanks for any assistance you can provide!</p>
  
  <hr>
  
  <pre><code>Sub HighlightAcronyms()
  Dim wdDoc As Object
  Dim wdFileName As Variant
  Dim TableNo As Integer 'table number in Word
  Dim oRow As Row
  Dim oCell As Cell
  Dim sCellText As String
  
  Dim oDoc_Source As Document
  Dim strListSep As String
  Dim oRange As Range
  Dim n As Long
  Dim sCellExpanded As String
  
      'Application.ScreenUpdating = False
      strListSep = Application.International(wdListSeparator)
  
  '*** Select acronym file and check that it contains one table
  
  wdFileName = WordApplicationGetOpenFileName("*.docx", True, True)
  If wdFileName = False Then Exit Sub '(user cancelled import file browser)
  Set wdDoc = GetObject(wdFileName) 'open Word file
  With wdDoc
      TableNo = wdDoc.Tables.Count
      If TableNo = 0 Then
          MsgBox "The file """ &amp; wdFileName &amp; """ contains no tables.", _
          vbExclamation, "Import Word Table"
  
          ElseIf TableNo &gt; 1 Then
               MsgBox "The file """ &amp; wdFileName &amp; """ contains multiple tables.", _
              vbExclamation, "Import Word Table"
      End If
  End With
  
  '*** steps through acronym column
  
  wdDoc.Tables(1).Cell(1, 1).Select
  Selection.SelectColumn
  For Each oCell In Selection.Cells
      ' Remove table cell markers from the text.
      sCellText = Left$(oCell.Range, Len(oCell.Range) - 2)
      sCellExpanded = "(" &amp; sCellText &amp; ")"
      n = 1
      'need to find foolproof method to select document for highlighting
      Documents(2).Activate
      Set oDoc_Source = ActiveDocument
  
      With oDoc_Source
          Set oRange = .Range
          With oRange.Find
              .Text = sCellText
              .Forward = True
              .Wrap = wdFindStop
              .Format = False
              .MatchCase = True
              .MatchWildcards = False
              Do While .Execute
                  If n = 1 Then
                      oRange.HighlightColorIndex = wdGreen
                  Else
                      oRange.HighlightColorIndex = wdYellow
                  End If
         'trying to add code here to expand oRange and compare it to sCellExpanded
                  n = n + 1
              Loop
          End With
      End With
  Next oCell
  
  Set wdDoc = Nothing
  End Sub
  </code></pre>