VBA replace takes too long to run

This code takes too long to run on a large data set.
I am wondering if anyone can improve the efficiency.
If column I each row is "US" then it replaces one character for a digit.
If it is not "US", it does a different character/digit replacement.

Again, it works great - but hangs the process.
Trying to improve user experience.
Thanks!!


Sub replace_Zones2()
Application.ScreenUpdating = False

    Dim Cell As range
    For Each Cell In range([I2], Cells(Rows.Count, "I").End(xlUp))
        If Cell = "US" Then
            Cells(Cell.Row, "C") = VBA.Replace(Cells(Cell.Row, "C"), "A", "2")
            Cells(Cell.Row, "C") = VBA.Replace(Cells(Cell.Row, "C"), "B", "3")
            Cells(Cell.Row, "C") = VBA.Replace(Cells(Cell.Row, "C"), "C", "4")
            Cells(Cell.Row, "C") = VBA.Replace(Cells(Cell.Row, "C"), "D", "5")
            Cells(Cell.Row, "C") = VBA.Replace(Cells(Cell.Row, "C"), "E", "6")
            Cells(Cell.Row, "C") = VBA.Replace(Cells(Cell.Row, "C"), "F", "7")
            Cells(Cell.Row, "C") = VBA.Replace(Cells(Cell.Row, "C"), "G", "8")
            Cells(Cell.Row, "C") = VBA.Replace(Cells(Cell.Row, "C"), "H", "9")
            Cells(Cell.Row, "C") = VBA.Replace(Cells(Cell.Row, "C"), "I", "10")
            Cells(Cell.Row, "C") = VBA.Replace(Cells(Cell.Row, "C"), "J", "11")
            Cells(Cell.Row, "C") = VBA.Replace(Cells(Cell.Row, "C"), "K", "12")
            Cells(Cell.Row, "C") = VBA.Replace(Cells(Cell.Row, "C"), "L", "13")
            Cells(Cell.Row, "C") = VBA.Replace(Cells(Cell.Row, "C"), "M", "14")
            Cells(Cell.Row, "C") = VBA.Replace(Cells(Cell.Row, "C"), "N", "15")
            Cells(Cell.Row, "C") = VBA.Replace(Cells(Cell.Row, "C"), "O", "16")
        Else
            Cells(Cell.Row, "C") = VBA.Replace(Cells(Cell.Row, "C"), "A", "2")
            Cells(Cell.Row, "C") = VBA.Replace(Cells(Cell.Row, "C"), "C", "3")
            Cells(Cell.Row, "C") = VBA.Replace(Cells(Cell.Row, "C"), "D", "4")
            Cells(Cell.Row, "C") = VBA.Replace(Cells(Cell.Row, "C"), "E", "5")
            Cells(Cell.Row, "C") = VBA.Replace(Cells(Cell.Row, "C"), "F", "6")
            Cells(Cell.Row, "C") = VBA.Replace(Cells(Cell.Row, "C"), "G", "7")
            Cells(Cell.Row, "C") = VBA.Replace(Cells(Cell.Row, "C"), "H", "8")
            Cells(Cell.Row, "C") = VBA.Replace(Cells(Cell.Row, "C"), "I", "9")
            Cells(Cell.Row, "C") = VBA.Replace(Cells(Cell.Row, "C"), "J", "10")
            Cells(Cell.Row, "C") = VBA.Replace(Cells(Cell.Row, "C"), "K", "11")
            Cells(Cell.Row, "C") = VBA.Replace(Cells(Cell.Row, "C"), "L", "12")
            Cells(Cell.Row, "C") = VBA.Replace(Cells(Cell.Row, "C"), "M", "13")
            Cells(Cell.Row, "C") = VBA.Replace(Cells(Cell.Row, "C"), "N", "14")
            Cells(Cell.Row, "C") = VBA.Replace(Cells(Cell.Row, "C"), "O", "15")
            Cells(Cell.Row, "C") = VBA.Replace(Cells(Cell.Row, "C"), "P", "16")
        End If
    Next
    
End Sub

Open in new window

Euro5Asked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

frankhelkCommented:
Maybe you should switch off auto recalculation while doing these things:

Application.Calculation = xlManual
'your code
Application.Calculation = xlAutomatic

Open in new window


On a second thought, it's unfortunate to do those operations on the cell values. Each cell value manipulation triggers a big heap of calculation, checks, etc. - these things are optimized and neglectible when doing a single change, but if you do multiple things on one cell they add up and add to an overhead tsunami if you do that for a large range.

Recommendation:

Put the cell value into a VBA string variable, use a funbction for manipulation, return the result and store it back.
Sub replace_Zones2()
    Application.ScreenUpdating = False

    Dim Cell As range
    For Each Cell In range([I2], Cells(Rows.Count, "I").End(xlUp))
        If Cell = "US" Then
            Cells(Cell.Row, "C") = Replacer1(Cells(Cell.Row, "C"))
        Else
            Cells(Cell.Row, "C") = Replacer2(Cells(Cell.Row, "C"))
        End If
    Next
    
End Sub

Function Replacer1(ByVal value as String) As String
    Replacer1 = VBA.Replace(value, "A", "2")
    Replacer1 = VBA.Replace(value, "B", "3")
    ' ... and so on ... 
End Function

Function Replacer2(ByVal value as String) As String
    Replacer2 = VBA.Replace(value, "A", "2")
    Replacer2 = VBA.Replace(value, "B", "3")
    ' ... and so on ... 
End Function

Open in new window

Besides of that you could write the function in a way that it won't use Replace(), which sweeps the string over and over again, roughly in that way:
Function Replacer1(ByVal value as String) As String
    For i = 1 To Len(vale)
        ch = Mid(vale, i, 1)
        Select Case ch
        Case "A"
            Replacer1 = Replacer1+"2"
        Case "B"
            Replacer1 = Replacer1+"3"

            ' ... and so on ...

        Case Else
            ' all other, not to replace things
            Replacer1 = Replacer1+ch
        End Select
    Next
End Function

Open in new window

That way you'll sweep over the string only once, and due to internal optimizations the Select/Case code is quite fast.
Roy CoxGroup Finance ManagerCommented:
Can you provide an example workbook
Euro5Author Commented:
@frankhelk - great thought, but there is nothing calculating. I certainly can often use that idea though - thanks!
Python 3 Fundamentals

This course will teach participants about installing and configuring Python, syntax, importing, statements, types, strings, booleans, files, lists, tuples, comprehensions, functions, and classes.

Rgonzo1971Commented:
Hi,

You also use a string

Sub replace_Zones2()
Application.ScreenUpdating = False
    Dim Cell As Range
    Dim strText as String
    For Each Cell In Range([I2], Cells(Rows.Count, "I").End(xlUp))
        strText = Cells(Cell.Row, "C")
        If Cell = "US" Then
            strText = VBA.Replace(strText, "A", "2")
            strText = VBA.Replace(strText, "B", "3")
            strText = VBA.Replace(strText, "C", "4")
            strText = VBA.Replace(strText, "D", "5")
            strText = VBA.Replace(strText, "E", "6")
            strText = VBA.Replace(strText, "F", "7")
            strText = VBA.Replace(strText, "G", "8")
            strText = VBA.Replace(strText, "H", "9")
            strText = VBA.Replace(strText, "I", "10")
            strText = VBA.Replace(strText, "J", "11")
            strText = VBA.Replace(strText, "K", "12")
            strText = VBA.Replace(strText, "L", "13")
            strText = VBA.Replace(strText, "M", "14")
            strText = VBA.Replace(strText, "N", "15")
            strText = VBA.Replace(strText, "O", "16")
        Else
            strText = VBA.Replace(strText, "A", "2")
            strText = VBA.Replace(strText, "C", "3")
            strText = VBA.Replace(strText, "D", "4")
            strText = VBA.Replace(strText, "E", "5")
            strText = VBA.Replace(strText, "F", "6")
            strText = VBA.Replace(strText, "G", "7")
            strText = VBA.Replace(strText, "H", "8")
            strText = VBA.Replace(strText, "I", "9")
            strText = VBA.Replace(strText, "J", "10")
            strText = VBA.Replace(strText, "K", "11")
            strText = VBA.Replace(strText, "L", "12")
            strText = VBA.Replace(strText, "M", "13")
            strText = VBA.Replace(strText, "N", "14")
            strText = VBA.Replace(strText, "O", "15")
            strText = VBA.Replace(strText, "P", "16")
        End If
        Cells(Cell.Row, "C") = strText
    Next
    
End Sub

Open in new window

Regards
frankhelkCommented:
Oops - looks like I overhauled your answer while beefing up my comment ... please reread it for further remommendations.
frankhelkCommented:
Oops - looks like I overhauled your answer while beefing up my comment ... please re-read it for further recommendations.
Rory ArchibaldCommented:
Try this version:

Sub replace_Zones2()
    Dim vC, vI
    Dim lLastRow              As Long
    Dim n                     As Long
    Application.ScreenUpdating = False

    lLastRow = Cells(Rows.Count, "I").End(xlUp).Row
    vI = Range("I2:I" & lLastRow).Value2
    vC = Range("C2:C" & lLastRow).Value2
    For n = LBound(vI, 1) To UBound(vI, 1)
        If vI(n, 1) = "US" Then
            vC(n, 1) = VBA.Replace(vC(n, 1), "A", "2")
            vC(n, 1) = VBA.Replace(vC(n, 1), "B", "3")
            vC(n, 1) = VBA.Replace(vC(n, 1), "C", "4")
            vC(n, 1) = VBA.Replace(vC(n, 1), "D", "5")
            vC(n, 1) = VBA.Replace(vC(n, 1), "E", "6")
            vC(n, 1) = VBA.Replace(vC(n, 1), "F", "7")
            vC(n, 1) = VBA.Replace(vC(n, 1), "G", "8")
            vC(n, 1) = VBA.Replace(vC(n, 1), "H", "9")
            vC(n, 1) = VBA.Replace(vC(n, 1), "I", "10")
            vC(n, 1) = VBA.Replace(vC(n, 1), "J", "11")
            vC(n, 1) = VBA.Replace(vC(n, 1), "K", "12")
            vC(n, 1) = VBA.Replace(vC(n, 1), "L", "13")
            vC(n, 1) = VBA.Replace(vC(n, 1), "M", "14")
            vC(n, 1) = VBA.Replace(vC(n, 1), "N", "15")
            vC(n, 1) = VBA.Replace(vC(n, 1), "O", "16")
        Else
            vC(n, 1) = VBA.Replace(vC(n, 1), "A", "2")
            vC(n, 1) = VBA.Replace(vC(n, 1), "C", "3")
            vC(n, 1) = VBA.Replace(vC(n, 1), "D", "4")
            vC(n, 1) = VBA.Replace(vC(n, 1), "E", "5")
            vC(n, 1) = VBA.Replace(vC(n, 1), "F", "6")
            vC(n, 1) = VBA.Replace(vC(n, 1), "G", "7")
            vC(n, 1) = VBA.Replace(vC(n, 1), "H", "8")
            vC(n, 1) = VBA.Replace(vC(n, 1), "I", "9")
            vC(n, 1) = VBA.Replace(vC(n, 1), "J", "10")
            vC(n, 1) = VBA.Replace(vC(n, 1), "K", "11")
            vC(n, 1) = VBA.Replace(vC(n, 1), "L", "12")
            vC(n, 1) = VBA.Replace(vC(n, 1), "M", "13")
            vC(n, 1) = VBA.Replace(vC(n, 1), "N", "14")
            vC(n, 1) = VBA.Replace(vC(n, 1), "O", "15")
            vC(n, 1) = VBA.Replace(vC(n, 1), "P", "16")
        End If
    Next
    Range("I2:I" & lLastRow).Value2 = vI
    Range("C2:C" & lLastRow).Value2 = vC

    Application.ScreenUpdating = True

End Sub

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
LazyFolkCommented:
Please find here attached a test file

1000 rows with ABCDEFGHIJKLMNOPQRSTUVWXYZ in column C and 2 caracter in column I

button "your code" call your macro
button "my code" call my macro

on the right of the button is displayed execution time in second

your code run in 0.3 sec
my code in 0.05 sec

hope this help.
my Code use ideas from frankhelk so if you accept this as answer, please share points...
Book1.xls
Martin LissOlder than dirtCommented:
This should be much faster.

Sub replace_Zones2()
Application.ScreenUpdating = False

Dim varDataRange As Variant ' Must be Variant
Dim lngRow As Long
Dim dblValue As Double
' This loads DateRange with the sheet's values. Note the use of ".Value"
varDataRange = Range("A2:I" & Range("I1048576").End(xlUp).Row).Value ' read all the values at once from the Excel grid, put into an array
For lngRow = 1 To UBound(varDataRange)
    If varDataRange(lngRow, 9) = "US" Then
        varDataRange(lngRow, 3) = VBA.Replace(varDataRange(lngRow, 3), "A", "2")
        varDataRange(lngRow, 3) = VBA.Replace(varDataRange(lngRow, 3), "B", "3")
        varDataRange(lngRow, 3) = VBA.Replace(varDataRange(lngRow, 3), "C", "4")
        varDataRange(lngRow, 3) = VBA.Replace(varDataRange(lngRow, 3), "D", "5")
        varDataRange(lngRow, 3) = VBA.Replace(varDataRange(lngRow, 3), "E", "6")
        varDataRange(lngRow, 3) = VBA.Replace(varDataRange(lngRow, 3), "F", "7")
        varDataRange(lngRow, 3) = VBA.Replace(varDataRange(lngRow, 3), "G", "8")
        varDataRange(lngRow, 3) = VBA.Replace(varDataRange(lngRow, 3), "H", "9")
        varDataRange(lngRow, 3) = VBA.Replace(varDataRange(lngRow, 3), "I", "10")
        varDataRange(lngRow, 3) = VBA.Replace(varDataRange(lngRow, 3), "J", "11")
        varDataRange(lngRow, 3) = VBA.Replace(varDataRange(lngRow, 3), "K", "12")
        varDataRange(lngRow, 3) = VBA.Replace(varDataRange(lngRow, 3), "L", "13")
        varDataRange(lngRow, 3) = VBA.Replace(varDataRange(lngRow, 3), "M", "14")
        varDataRange(lngRow, 3) = VBA.Replace(varDataRange(lngRow, 3), "N", "15")
        varDataRange(lngRow, 3) = VBA.Replace(varDataRange(lngRow, 3), "O", "16")
    Else
        varDataRange(lngRow, 3) = VBA.Replace(varDataRange(lngRow, 3), "A", "2")
        varDataRange(lngRow, 3) = VBA.Replace(varDataRange(lngRow, 3), "C", "3")
        varDataRange(lngRow, 3) = VBA.Replace(varDataRange(lngRow, 3), "D", "4")
        varDataRange(lngRow, 3) = VBA.Replace(varDataRange(lngRow, 3), "E", "5")
        varDataRange(lngRow, 3) = VBA.Replace(varDataRange(lngRow, 3), "F", "6")
        varDataRange(lngRow, 3) = VBA.Replace(varDataRange(lngRow, 3), "G", "7")
        varDataRange(lngRow, 3) = VBA.Replace(varDataRange(lngRow, 3), "H", "8")
        varDataRange(lngRow, 3) = VBA.Replace(varDataRange(lngRow, 3), "I", "9")
        varDataRange(lngRow, 3) = VBA.Replace(varDataRange(lngRow, 3), "J", "10")
        varDataRange(lngRow, 3) = VBA.Replace(varDataRange(lngRow, 3), "K", "11")
        varDataRange(lngRow, 3) = VBA.Replace(varDataRange(lngRow, 3), "L", "12")
        varDataRange(lngRow, 3) = VBA.Replace(varDataRange(lngRow, 3), "M", "13")
        varDataRange(lngRow, 3) = VBA.Replace(varDataRange(lngRow, 3), "N", "14")
        varDataRange(lngRow, 3) = VBA.Replace(varDataRange(lngRow, 3), "O", "15")
        varDataRange(lngRow, 3) = VBA.Replace(varDataRange(lngRow, 3), "P", "16")
    End If
Next
Range("A2:I" & Range("I1048576").End(xlUp).Row).Value = varDataRange ' writes all the results back to the range at once
End Sub

Open in new window

Rory ArchibaldCommented:
Isn't that basically the same as my code except you use one larger range (which seems unnecessary if you're only changing one column)?
Rory ArchibaldCommented:
Using @LazyFolk's sample file, the results on my (poor, work) machine are:

Original code: 34.617 s
LazyFolk's code: 3.047 s
My code: 0.078 s

Just sayin'. :)
Martin LissOlder than dirtCommented:
Isn't that basically the same as my code except you use one larger range (which seems unnecessary if you're only changing one column)?
Sorry, Rory, I didn't actually look at your code. And you're right I don't need the larger range but I don't think it will make any measurable difference. There are some other differences so if you would, please time my code. It might actually be slightly faster then yours.
Rory ArchibaldCommented:
What are the other differences? I must be missing something?

Your code takes exactly the same amount of time - after fixing the row count problem since the sample file was an xls and you hardcoded the 1m+ rows ;)

PS Reading this thread through, I realise I may come across as grumpy about this - I'm really not! Just curious as to what is different?
Martin LissOlder than dirtCommented:
I would do the same (and have) so don't worry. But you win:) With 12,000 rows of data with text 1 to 4 characters long, your code took 172 ms to run while mine took 188ms.
Martin LissOlder than dirtCommented:
@Euro5: If you like either Rory's or my code then please give all the points to him since he posted before me.
Euro5Author Commented:
@Rory, Thanks, MUCH faster. This was a huge help because I can accommodate additional rows without having it fail due to memory issues. This was really important.

@Martin, Thanks for the feedback.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.