How to bypass 255 character limit of VBA mass replace function? - vba

Question

Sub MultiFindNReplace()
'Update 20140722
Dim Rng As Range
Dim InputRng As Range, ReplaceRng As Range
xTitleId = "KutoolsforExcel"
Set InputRng = Application.Selection
Set InputRng = Application.InputBox("Original Range ", xTitleId, InputRng.Address, Type:=8)
Set ReplaceRng = Application.InputBox("Replace Range :", xTitleId, Type:=8)
Application.ScreenUpdating = False
For Each Rng In ReplaceRng.Columns(1).Cells
    InputRng.Replace what:=Rng.Value, replacement:=Rng.Offset(0, 1).Value
Next
Application.ScreenUpdating = True
End Sub
Source:
Extend Office - How To Find And Replace Multiple Values At Once In Excel?
Data type:
Using the Excel Application.InputBox method
I tried to replace Type:=8 with Type:=2 for text instead of range, but it didn't work. Please help me by pass the 255 character limit.
Example Data:
Google Spreadsheet

Answer 1

I'm not 100% clear on what data you have and what you're trying to do, but I think you will have more success if you use the:
MSDN : Replace Function (VBA)
...instead of:
Office Support: Range.Replace Method (Excel)
The second one is basically a worksheet function, therefore subject to various limits that the first one doesn't have.
Your code should require only minor changes to adapt to the Replace function.

Answer 2

Replace Whole Cell Content
So my idea to replace whole cell contents is:
Read replacements into a dictionary
Read data into an array
Replace in array
Write array back to cells
I choose the array because using arrays is much faster than working with cells. So we have only one slow cell reading and one slow cell writing and working with the array is fast.
Option Explicit
Public Sub MultiReplaceWholeCells()
Const xTitleId As String = "KutoolsforExcel"
Dim InputRange As Range
Set InputRange = Range("A2:F10") 'Application.InputBox("Original Range ", xTitleId, InputRng.Address, Type:=8)
Dim ReplaceRange As Range
Set ReplaceRange = Range("A12:B14") 'Application.InputBox("Original Range ", xTitleId, InputRng.Address, Type:=8)
Dim Replacements As Object
Set Replacements = CreateObject("Scripting.Dictionary")
'read replacements into an array
Dim ReplaceValues As Variant
ReplaceValues = ReplaceRange.Value
'read replacements into a dictionary
Dim iRow As Long
For iRow = 1 To ReplaceRange.Rows.Count
Replacements.Add ReplaceValues(iRow, 1), ReplaceValues(iRow, 2)
Next iRow
'read values into an array
Dim Data As Variant
Data = InputRange.Value
'loop through array data and replace whole data
Dim r As Long, c As Long
For r = 1 To InputRange.Rows.Count
For c = 1 To InputRange.Columns.Count
If Replacements.Exists(Data(r, c)) Then
Data(r, c) = Replacements(Data(r, c))
End If
Next c
Next r
'write data from array back to range
InputRange.Value = Data
End Sub
Replace Part Of Cell Content
For replacing a part of a cell this would be slower:
Option Explicit
Public Sub MultiReplaceWholeCells()
Const xTitleId As String = "KutoolsforExcel"
Dim InputRange As Range
Set InputRange = Range("A2:F10") 'Application.InputBox("Original Range ", xTitleId, InputRng.Address, Type:=8)
Dim ReplaceRange As Range
Set ReplaceRange = Range("A12:B14") 'Application.InputBox("Original Range ", xTitleId, InputRng.Address, Type:=8)
'read replacements into an array
Dim ReplaceValues As Variant
ReplaceValues = ReplaceRange.Value
'read values into an array
Dim Data As Variant
Data = InputRange.Value
'loop through array data and replace PARTS of data
Dim r As Long, c As Long
For r = 1 To InputRange.Rows.Count
For c = 1 To InputRange.Columns.Count
Dim iRow As Long
For iRow = 1 To ReplaceRange.Rows.Count
Data(r, c) = Replace(Data(r, c), ReplaceValues(iRow, 1), ReplaceValues(iRow, 2))
Next iRow
Next c
Next r
'write data from array back to range
InputRange.Value = Data
End Sub
If you only need to replace whole cell contents use the first one which should be faster.
Procedure to Do Both Replacement Types
Or if you need both write a procedure so you can chose if you need to replace xlWhole or xlPart. Even a different output range would be possible.
Option Explicit
Public Sub TestReplace()
Const xTitleId As String = "KutoolsforExcel"
Dim InputRange As Range
Set InputRange = Range("A2:F10") 'Application.InputBox("Original Range ", xTitleId, InputRng.Address, Type:=8)
Dim ReplaceRange As Range
Set ReplaceRange = Range("A12:B14") 'Application.InputBox("Original Range ", xTitleId, InputRng.Address, Type:=8)
MultiReplaceInCells InputRange, ReplaceRange, xlWhole, Range("A20") 'replace whole to output range
MultiReplaceInCells InputRange, ReplaceRange, xlPart, Range("A30") 'replace parts to output range
MultiReplaceInCells InputRange, ReplaceRange, xlWhole 'replace whole in place
End Sub
Public Sub MultiReplaceInCells(InputRange As Range, ReplaceRange As Range, Optional LookAt As XlLookAt = xlWhole, Optional OutputRange As Range)
'read replacements into an array
Dim ReplaceValues As Variant
ReplaceValues = ReplaceRange.Value
'read values into an array
Dim Data As Variant
Data = InputRange.Value
Dim r As Long, c As Long, iRow As Long
If LookAt = xlPart Then
'loop through array data and replace PARTS of data
For r = 1 To InputRange.Rows.Count
For c = 1 To InputRange.Columns.Count
For iRow = 1 To ReplaceRange.Rows.Count
Data(r, c) = Replace(Data(r, c), ReplaceValues(iRow, 1), ReplaceValues(iRow, 2))
Next iRow
Next c
Next r
Else
'read replacements into a dictionary
Dim Replacements As Object
Set Replacements = CreateObject("Scripting.Dictionary")
For iRow = 1 To ReplaceRange.Rows.Count
Replacements.Add ReplaceValues(iRow, 1), ReplaceValues(iRow, 2)
Next iRow
'loop through array data and replace WHOLE data
For r = 1 To InputRange.Rows.Count
For c = 1 To InputRange.Columns.Count
If Replacements.Exists(Data(r, c)) Then
Data(r, c) = Replacements(Data(r, c))
End If
Next c
Next r
End If
'write data from array back to range
If OutputRange Is Nothing Then
InputRange.Value = Data
Else
OutputRange.Resize(InputRange.Rows.Count, InputRange.Columns.Count).Value = Data
End If
End Sub