How to Find / Replace Multiple Values within Selected Cells using Arrays?

Question

I am attempting to build a VBA Macro within an Excel Worksheet name "wsPivotPreCCI".

Within Column "C", I would like to find multiple text strings, and replace it with the same text string.
Example:

Find: "TIPS TELEPHONE", "TIPS TELEPHONE OTHER", "TIPS, TELEPHONE", or "TIPS,TELEPHONE"
Replace All with: "TIPS, TELEPHONE, OTHER"

Through hours of researching, multiple attempts(noted below), I found these posts to be the most helpful, but I still can't seem to get the Loop and Replacement right.

VBA find/replace using array for cell range

find and replace values in database using an array VBA

My Find/Replacement arrays are:

FindTips = Array("TIPS TELEPHONE", "TIPS TELEPHONE OTHER", "TIPS, TELEPHONE", "TIPS,TELEPHONE")
RplcTips = Array("TIPS, TELEPHONE, OTHER")
        
FindAuto = Array("AUTO - RENTAL, PARKING & TOLLS", "PARKING AND TOLLS", "PARKING TOLLS", _
"RENTAL PARKING & TOLLS", "RENTAL PARKING TOLLS", "AUTO RENTAL, PARKING & TOLLS")
RplcAuto = "AUTO - RENTAL, PARKING & TOLLS"
        
FindMisc = Array("MISCELLANEOUS EXPENSE", "MISCELLANEOUS")
RplcMisc = "MISCELLANEOUS EXPENSE"
        
FindTraining = Array("TRAINING & SEMINARS", "TRAINING & SEMINARS-OTHERS")
RplcTraining = "TRAINING & SEMINARS"

Here is my Current Code. I just one Find/Replace Array example (but I do need replace all arrays):

Options Explicit
Sub Multi_FindReplace()

With wsPivotPreCCI
    Dim Lrow As Long
    Dim Rng As Range
    Dim FindTips As Variant
    Dim RplcTips As Variant
    Dim i As Long
    
    Lrow = .Cells(.Rows.Count, "A").End(xlUp).Row
    Set Rng = .Range("C2:C" & Lrow)
    
    FindTips = Array("TIPS TELEPHONE", "TIPS TELEPHONE OTHER", "TIPS, TELEPHONE", "TIPS,TELEPHONE")
    RplcTips = Array("TIPS, TELEPHONE, OTHER")
    
    'Loop through each item in array list

End With
End Sub

These are the different lines I tried to use, with the Errors noted on the line where the error occurred.

    For i = LBound(FindTips) To UBound(FindTips)
        Rng.Cells.Replace What:=FindTips(i), Replacement:=RplcTips(i)  '<-Subscript Out of Range
    Next i

    For i = LBound(FindTips) To UBound(FindTips)
        .Cells.Replace FindTips(i, 1), RplcTips(i, 1), xlWhole, xlByRows   '<-Subscript out of Range
    Next

    Dim arr As Variant
    For i = LBound(FindTips) To UBound(FindTips)
        For Each arr In Rng
            Rng.Cells.Replace What:=FindTips(i), Replacement:=RplcTips(i)  '<-Subscript out of Range
        Next arr
    Next i

    With Rng
        For i = LBound(FindTips) To UBound(FindTips)
            .Cells.Replace FindTips(i), RplcTips(i)  '<-Subscript out of Range
        Next
    End With

'Finally Looped through Column "C", but All the cells changed, and then received Subscript out of range
    For i = LBound(FindTips) To UBound(FindTips)
        For Each FindTips In Rng
            Rng.Cells.Replace What:=FindTips(i), Replacement:=RplcTips(i)
        Next FindTips
    Next i

After the last attempt, I found this post: VBA (Microsoft Excel) replace Array with String

So, I adjusted the RplcTips from an Array to a String

Options Explicit
Sub Multi_FindReplace()

With wsPivotPreCCI
    Dim Lrow As Long
    Dim Rng As Range
    Dim FindTips As Variant
    Dim RplcTips As String
    Dim i As Long
    
    Lrow = .Cells(.Rows.Count, "A").End(xlUp).Row
    Set Rng = .Range("C2:C" & Lrow)
    
    FindTips = Array("TIPS TELEPHONE", "TIPS TELEPHONE OTHER", "TIPS, TELEPHONE", "TIPS,TELEPHONE")
    RplcTips = "TIPS, TELEPHONE, OTHER"
    
    'Loop through each item in array list
    For i = LBound(FindTips) To UBound(FindTips)
        For Each FindTips In Rng
            Rng.Cells.Replace FindTips(i), RplcTips
        Next FindTips
    Next i

End With
End Sub

This code still changed every cell (in Column C) to the Rplctips value, and appeared to continue looking (until I stopped macro).

Question 1: Should the Replacement Values be String instead of Array?

Question 2: What is the best way to replace all these values in Column C?

BigBen · Accepted Answer · 2020-12-15T17:28:41.940

2

Yes, the replacement value RplcTips should be a String because you're dealing with one value, not an array of values.

Then, you don't need to loop over cells to replace. Call Replace on the entire range. Change

For i = LBound(FindTips) To UBound(FindTips)
    For Each FindTips In Rng
        Rng.Cells.Replace FindTips(i), RplcTips
    Next FindTips
Next i

to

For i = LBound(FindTips) To UBound(FindTips)
    Rng.Replace FindTips(i), RplcTips, xlWhole, xlByColumns, True
Next i

See the Range.Replace docs for detail on the parameters.

edited Dec 15 '20 at 17:28

answered Dec 15 '20 at 17:07

BigBen

46,229
7
24
40

Thank you!! Is there a way to (consolidate) add in the other Find/Replace Arrays? Or do I need to do separate loops for those? – CDay20 Dec 15 '20 at 18:13
You could refactor your subroutine to take two parameters: the find array, and the replacement string. – BigBen Dec 15 '20 at 18:14
Ok, I'll look that up. Should I submit that as a new question if I get stuck then? – CDay20 Dec 15 '20 at 19:30
Sure. As a start, `Sub MultiFindReplace(ByVal findArray As Variant, ByVal replacement As String)`. Then in a *new* subroutine, you'll do something like `MultiFindReplace FindMisc, RplcMisc` – BigBen Dec 15 '20 at 19:33

How to Find / Replace Multiple Values within Selected Cells using Arrays?

1 Answers1