View Single Post
 
Old 02-09-2014, 01:49 PM
mrayncrental mrayncrental is offline Windows 7 64bit Office 2007
Novice
 
Join Date: Feb 2014
Posts: 15
mrayncrental is on a distinguished road
Talking Solved

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
Reply With Quote