This worked perfectly and is more efficient. Added 2 minor tweaks:
- Some of my cells have more than one set of [] words, so I subtracted the row number to research the cell again if first set is found
- Added additional row return
Code:
Sub 1()
'
' Macro to take any [] words from column 3 and move to column 2,
' then search and replace to remove the brackets
'
Dim rng As Range, rng2 As Range, sText As String
Dim aTbl As Table, iRow As Integer, aCell As Cell
Set aTbl = ActiveDocument.Tables(1)
Set rng = aTbl.Range
For iRow = 1 To aTbl.Rows.Count
Set rng = aTbl.Cell(iRow, 3).Range
With rng.Find
.ClearFormatting
.Text = "\[*\]"
.MatchWildcards = True
If .Execute = True Then
sText = Replace(rng.Text, "[", "")
sText = Replace(sText, "]", "")
Set rng2 = aTbl.Cell(iRow, 2).Range
If Len(rng2.Text) > 2 Then
rng2.MoveEnd Unit:=wdCharacter, Count:=-1
rng2.Collapse Direction:=wdCollapseEnd
rng2.Text = vbCr & vbCr & sText
Else
rng2.Text = sText
End If
rng.Delete
' Don't advance cell unless no brackets found
iRow = iRow - 1
End If
End With
Next iRow
End Sub