Code taking too long to run

[Dokat]

Hi,

I have below code that i am using to replace values in a worksheet. It works fine however taking too long to run. There are over 600K rows in the sheet. Is there a way to simplify this code to run faster and more efficiently?

Sub ReplaceName()
'
    Application.ScreenUpdating = False
'
    Dim lr      As Long
    Dim cell    As Range
'
    lr = Worksheets("POS").Range("B" & Rows.Count).End(xlUp).Row
'
    For Each cell In Worksheets("POS").Range("B2:B" & lr)
        cell.Value = Replace((cell.Value), "Zebra Pen Corporation", "Zebra")
        cell.Value = Replace((cell.Value), "Newell Brands", "Newell")
        cell.Value = Replace((cell.Value), "Pilot Pen", "Pilot")
   Next
  
    For Each cell In Worksheets("POS").Range("G2:G" & lr)
        cell.Value = Replace((cell.Value), "Total Brick & Mortar", "Brick & Mortar")
        cell.Value = Replace((cell.Value), "Total Ecommerce", "Ecommerce")
  Next
  
    For Each cell In Worksheets("POS").Range("E2:E" & lr)
        cell.Value = Replace((cell.Value), "Not Applicable", "All Other")
        cell.Value = Replace((cell.Value), "Not Specified", "All Other")
Next
  
    For Each cell In Worksheets("POS").Range("H2:H" & lr)
        cell.Value = Replace((cell.Value), "$ Velocity - Weighted", "$ Velocity")
        cell.Value = Replace((cell.Value), "Unit Velocity - Weighted", "Unit Velocity")
        cell.Value = Replace((cell.Value), "% Distribution - Weighted", "% Distribution")
        cell.Value = Replace((cell.Value), "% of Stores Selling - Unweighted", "% of Stores Selling")
        cell.Value = Replace((cell.Value), "Avg # of Items Where Carried - Weighted", "Avg # of Items")
        cell.Value = Replace((cell.Value), "$ Velocity per Items Carried - Weighted", "$ Velocity")
        cell.Value = Replace((cell.Value), "Unit Velocity per Items Carried - Weighted", "Unit Velocity")
 Next
  
    For Each cell In Worksheets("POS").Range("F2:F" & lr)
        cell.Value = Replace((cell.Value), "Single", "1")
    Next
    
    Application.ScreenUpdating = True
End Sub

 

[johnnyL]

Why are none of the suggested codes checking all of the boxes for what needed to be checked in the original post?

 

[johnnyL]

Ok, I decided to take a whack at it. Conducted tests for 600 thousand rows. Every cell needing to be changed.

I tested the Original post code 1 time ... took over 28 minutes. Ouch!

@tonyyy code submission, Tested 5 times and averaged 29.275 seconds average over 5 tests:

Sub ReplaceName3()          ' tonyyy
'
    Dim startTime               As Single
    startTime = Timer                                                                               '   Start the stopwatch
'
Dim lr As Long
Dim arr As Variant
Dim i As Long

Application.ScreenUpdating = False
lr = Worksheets("POS").Range("B" & Rows.Count).End(xlUp).Row
arr = Sheets("POS").Range("B2:H" & lr)

For i = 1 To UBound(arr)
    arr(i, 1) = Replace((arr(i, 1)), "Pilot Pen", "Pilot")
    arr(i, 4) = Replace((arr(i, 4)), "Not Applicable", "All Other")
    arr(i, 5) = Replace((arr(i, 5)), "Single", "1")
    arr(i, 6) = Replace((arr(i, 6)), "Total Brick & Mortar", "Brick & Mortar")
    arr(i, 6) = Replace((arr(i, 6)), "Total Ecommerce", "Ecommerce")
    arr(i, 7) = Replace((arr(i, 7)), "$ Velocity - Weighted", "$ Velocity")
    arr(i, 7) = Replace((arr(i, 7)), "Unit Velocity - Weighted", "Unit Velocity")
    arr(i, 7) = Replace((arr(i, 7)), "% Distribution - Weighted", "% Distribution")
    arr(i, 7) = Replace((arr(i, 7)), "% of Stores Selling - Unweighted", "% of Stores Selling")
    arr(i, 7) = Replace((arr(i, 7)), "Avg # of Items Where Carried - Weighted", "Avg # of Items")
    arr(i, 7) = Replace((arr(i, 7)), "$ Velocity per Items Carried - Weighted", "$ Velocity")
    arr(i, 7) = Replace((arr(i, 7)), "Unit Velocity per Items Carried - Weighted", "Unit Velocity")
Next i

Sheets("POS").Range("B2:H" & lr) = arr
Application.ScreenUpdating = True
'
    Debug.Print "Time to complete = " & Timer - startTime & " seconds."                                 ' 29.275 seconds average over 5 tests
End Sub

Next up was @kevin9999 code, Tested 5 times and averaged 14.811 seconds average over 5 tests, I am guessing you could add about .75 seconds if all stipulations were met:

Sub If_Option()                                         ' Kevin9999
'
    Dim startTime               As Single
    startTime = Timer                                                                               '   Start the stopwatch
'
    Dim lr As Long
    Dim ws As Worksheet: Set ws = Worksheets("POS")
    Dim ar, i As Long
    lr = ws.Cells(Rows.Count, 2).End(xlUp).Row
    Application.ScreenUpdating = 0
    
    ar = ws.Range("B2:H" & lr)
    
    For i = 1 To UBound(ar)
        If ar(i, 1) = "Pilot Pen" Then ar(i, 1) = "Pilot"
        If ar(i, 4) = "Not Applicable" Then ar(i, 4) = "All Other"
        If ar(i, 5) = "Single" Then ar(i, 5) = "1"
        If ar(i, 6) = "Total Brick & Mortar" Then ar(i, 6) = "Brick & Mortar"
        If ar(i, 6) = "Total Ecommerce" Then ar(i, 6) = "Ecommerce"
        If ar(i, 7) = "$ Velocity - Weighted" Then ar(i, 7) = "$ Velocity"
        If ar(i, 7) = "Unit Velocity - Weighted" Then ar(i, 7) = "Unit Velocity"
        If ar(i, 7) = "% Distribution - Weighted" Then ar(i, 7) = "% Distribution"
        If ar(i, 7) = "% of Stores Selling - Unweighted" Then ar(i, 7) = "% of Stores Selling"
        If ar(i, 7) = "Avg # of Items Where Carried - Weighted" Then ar(i, 7) = "Avg # of Items"
        If ar(i, 7) = "$ Velocity per Items Carried - Weighted" Then ar(i, 7) = "$ Velocity"
        If ar(i, 7) = "Unit Velocity per Items Carried - Weighted" Then ar(i, 7) = "Unit Velocity"
    Next i
    
    ws.Range("B2:H" & lr).Value2 = ar
'
    Debug.Print "Time to complete = " & Timer - startTime & " seconds."                                 ' 14.811 seconds average over 5 tests
End Sub

Version I came up with:

Sub ReplaceNameJohnnyL()
'
    Dim startTime               As Single
    startTime = Timer                                                                               '   Start the stopwatch
'
    Application.ScreenUpdating = False
'
    Dim ArrayRow        As Long
    Dim lr              As Long
    Dim cell            As Range
    Dim BcolumnArray    As Variant
'
    lr = Worksheets("POS").Range("B" & Rows.Count).End(xlUp).Row
    BcolumnArray = Worksheets("POS").Range("B2:H" & lr)
'
    For ArrayRow = 1 To lr - 1
        Select Case BcolumnArray(ArrayRow, 1)
            Case Is = "Zebra Pen Corporation": BcolumnArray(ArrayRow, 1) = "Zebra"
            Case Is = "Newell Brands": BcolumnArray(ArrayRow, 1) = "Newell"
            Case Is = "Pilot Pen": BcolumnArray(ArrayRow, 1) = "Pilot"
        End Select
'
        Select Case BcolumnArray(ArrayRow, 4)
            Case Is = "Not Applicable", "Not Specified": BcolumnArray(ArrayRow, 4) = "All Other"
        End Select
'
        Select Case BcolumnArray(ArrayRow, 5)
            Case Is = "Single": BcolumnArray(ArrayRow, 5) = "1"
        End Select
'
        Select Case BcolumnArray(ArrayRow, 6)
            Case Is = "Total Brick & Mortar": BcolumnArray(ArrayRow, 6) = "Brick & Mortar":
            Case Is = "Total Ecommerce": BcolumnArray(ArrayRow, 6) = "Ecommerce"
        End Select
'
        Select Case BcolumnArray(ArrayRow, 7)
            Case Is = "$ Velocity - Weighted", "$ Velocity per Items Carried - Weighted": BcolumnArray(ArrayRow, 7) = "$ Velocity"
            Case Is = "Unit Velocity - Weighted", "Unit Velocity per Items Carried - Weighted": BcolumnArray(ArrayRow, 7) = "Unit Velocity"
            Case Is = "% Distribution - Weighted": BcolumnArray(ArrayRow, 7) = "% Distribution"
            Case Is = "% of Stores Selling - Unweighted": BcolumnArray(ArrayRow, 7) = "% of Stores Selling"
            Case Is = "Avg # of Items Where Carried - Weighted": BcolumnArray(ArrayRow, 7) = "Avg # of Items"
        End Select
    Next
'
    Worksheets("POS").Range("B2:H" & lr) = BcolumnArray
'
    Application.ScreenUpdating = True
'
    Debug.Print "Time to complete = " & Timer - startTime & " seconds."                                 ' 12.183 seconds average over 5 tests
End Sub

Just over 12 second average for 600K rows, all stipulations met for the original post.