CODEWITHSUNDEEP
vbaexcel
Chris
Chris

Reputation: 1

Find/replace macro for multiple worksheets

I'm working with a multiple find/replace macro found at The Spreadsheet Guru and have run into a problem. I have a spreadsheet with multiple workbooks containing names and roster shifts, and I need to update names by appending qualifications using a table in another worksheet EG:

A1   Name    Replace
A2   Smith   Smith (123)
A3   Jones   Jones (ABC)

I need to 'LookAt:=x1Part' as the names will sometimes have other info on the end (such as shift lengths etc). It looks to me like the code below should step through each worksheet, but it seems to run the find/replace for the whole workbook for each sheet it looks at. ie. if there are 3 worksheets, 'Smith' will become 'Smith (123) (123) (123)'

Is there a way I can prevent this from happening? Is the find/replace macro the best for this purpose?

    Sub Multi_FindReplace()
'PURPOSE: Find & Replace a list of text/values throughout entire workbook from a table
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault

Dim sht As Worksheet
Dim thing As Worksheet
Dim fndList As Integer
Dim rplcList As Integer
Dim tbl As ListObject
Dim myArray As Variant

'Create variable to point to your table
  Set tbl = Worksheets("Sheet1").ListObjects("Table1")

'Create an Array out of the Table's Data
  Set TempArray = tbl.DataBodyRange
  myArray = Application.Transpose(TempArray)

'Designate Columns for Find/Replace data
  fndList = 3
  rplcList = 4

'Loop through each item in Array lists
  For x = LBound(myArray, 1) To UBound(myArray, 2)
    'Loop through each worksheet in ActiveWorkbook (skip sheet with table in it)
      For Each sht In ActiveWorkbook.Worksheets
        If sht.Name <> tbl.Parent.Name Then

          sht.Cells.Replace What:=myArray(fndList, x), Replacement:=myArray(rplcList, x), _
            LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
            SearchFormat:=False, ReplaceFormat:=False

        End If
     Next sht
  Next x

End Sub

Upvotes: 0

Views: 1100

Answers (1)

Tim Williams
Tim Williams

Reputation: 166391

Code looks OK though I would prefer it without the Transpose operation:

Public Sub MultiFindReplace()

Dim sht As Worksheet
Dim fndList As Long, rplcList As Long, x As Long
Dim tbl As ListObject
Dim myArray As Variant

'Create variable to point to your table
  Set tbl = Worksheets("Sheet1").ListObjects("Table1")
  myArray = tbl.DataBodyRange.Value

'Designate Columns for Find/Replace data
  fndList = 1
  rplcList = 2

'Loop through each item in Array lists
  For x = LBound(myArray, 1) To UBound(myArray, 1)
    'Loop through each worksheet in ActiveWorkbook (skip sheet with table in it)
      For Each sht In ActiveWorkbook.Worksheets
        If sht.Name <> tbl.Parent.Name Then

          sht.Cells.Replace What:=myArray(x, fndList), _
            Replacement:=myArray(x, rplcList), _
            LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
            SearchFormat:=False, ReplaceFormat:=False

        End If
     Next sht
  Next x

End Sub

I can only get the results you show by running it multiple times...

Upvotes: 1

Related Questions