Excel VBA Replace with Array Groups

Question

Right now I am using a horribly inefficient way for a replacement function:

Dim Replacement As String
Dim rngRepVal As Object

Set rngRepVal = Sheets("data").Range(Cells(1, 3), Cells(intRowLast, 3))
Replacement = ActiveCell.Value
rngRepVal.Replace What:="123", Replacement:="ABC", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False
rngRepVal.Replace What:="234", Replacement:="ABC", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False
rngRepVal.Replace What:="456", Replacement:="DEF", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False
... [goes on for 50 lines]
Set rngRepVal = Nothing

I am wondering if this can be achieved with arrays. Something like:

Dim aWhat() As String
Dim aReplacement() As String

aWhat = Split("ABC|DEF|GHI|JKL", "|")
aReplacement = Split(Array("123", 456")|Array("789","1000"), "|") '<-not sure how to organise this

Essentially 123 & 456 get replaced by ABC, 789 & 1000 get replaced by DEF etc. in a replace loop> Any insights on how to organise the two arrays? Thanks!

Answer 1

I would try this:

aWhat=Split("ABC|ABC|DEF|DEF|GHI|GHI...","|")
aReplacement=Split("123|456|789|.....","|")
For i=1 to UBound(aWhat)
  rngRepVal.Replace what:=aWhat[i], Replacement:=aReplacement[i], ....
Next i

Just make sure there's the same number of elements in both arrays.

Answer 2

Your Replace(s) are fine - its the cell by cell loop and selection that is inefficient. Try something like this for three replaces over the entire range at once.

Sub Recut()
Dim rng1 As Range
Set rng1 = Sheets("data").Range(Sheets("data").Cells(1, 3), Sheets("data").Cells(Rows.Count, 3).End(xlUp))
With rng1
    .Replace What:="123", Replacement:="ABC", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False
    .Replace What:="234", Replacement:="ABC", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False
    .Replace What:="456", Replacement:="DEF", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False
End With
End Sub

Answer 3

I think found it, by accident:

Dim aOld() As Variant
Dim aNew() As Variant
Dim Group As Variant
Dim Word As Variant
Dim y As Long

aNew = Array("ABC", "DEF", "GHI", "JKL")
aOld = Array(Array("123", "456"), Array("789", "1000"))

With Range("A:A")
    For Each Group In aOld
        For Each Word In Group
            .Replace What:=Word, Replacement:=aNew(y), LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False
        Next
    y = y + 1
    Next
End With