Reputation: 23
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?
Upvotes: 2
Views: 2324
Reputation: 49998
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.
Upvotes: 2