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

 

[kevin9999]

This is a variation on the Solution provided by @tonyyy . For some reason, changing the Replace function with a simple If...Then seems to increase the speed noticeably. Just offering an alternative.

Sub If_Option()
    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
End Sub

 

[Dokat]

This is a variation on the Solution provided by @tonyyy . For some reason, changing the Replace function with a simple If...Then seems to increase the speed noticeably. Just offering an alternative.

Sub If_Option()
    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
End Sub

Yes thank you this code runs almost 50% faster.

 

[kevin9999]

Yes thank you this code runs almost 50% faster.

Thank you for the feedback. Please note that what I did was merely a slight variation on the work done by @tonyyy , and they deserve all the credit for a solution.

 

[Dokat]

Thank you for the feedback. Please note that what I did was merely a slight variation on the work done by @tonyyy , and they deserve all the credit for a solution.

Yes Thank you both

 

[tonyyy]

Yes Thank you both

Dokat - You're very welcome.

@kevin999 - Thanks for the assist.

 

[johnnyL]

This is a variation on the Solution provided by @tonyyy . For some reason, changing the Replace function with a simple If...Then seems to increase the speed noticeably. Just offering an alternative.

Assuming the 50% speed reference refers to the original code ...The use of the array vs continual sheet checking was the major factor in the speed increase.

 

[kevin9999]

Assuming the 50% speed reference refers to the original code ...The use of the array vs continual sheet checking was the major factor in the speed increase.

Actually no. I measured a 30% speed increase v. the 'original' array solution.

 

[johnnyL]

Ahh, ok.

 

[tonyyy]

Actually no. I measured a 30% speed increase v. the 'original' array solution

Oh... so what was the difference between the Replace vs If/Then on the last array solution?

 

[kevin9999]

Oh... so what was the difference between the Replace vs If/Then on the last array solution?

With 600K rows of data I measured 15 secs for Replace v. 11 secs for If...Then (on average)