Code taking too long to run

D

Dokat

Active Member
Joined
Jan 19, 2015
Messages
304
Office Version
  1. 365
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?

VBA Code: 
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
 

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
Sort by date Sort by votes
Instead of looping though each cell in the range, consider using the Range.Replace method. For example, replace this
VBA Code: 
    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
with this
VBA Code: 
    With Worksheets("POS").Range("B2:B" & lr)
        .Replace What:="Zebra Pen Corporation", Replacement:="Zebra"
        .Replace What:="Newell Brands", Replacement:="Newell"
        .Replace What:="Pilot Pen", Replacement:="Pilot"
    End With
 
Upvote 0
Another approach would be to do your replacements in an Array...

VBA Code: 
Sub ReplaceName2()
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:B" & lr)
For i = 1 To UBound(arr)
    arr(i, 1) = Replace((arr(i, 1)), "Pilot Pen", "Pilot")
Next i
Sheets("POS").Range("B2:B" & lr) = arr

arr = Sheets("POS").Range("E2:E" & lr)
For i = 1 To UBound(arr)
    arr(i, 1) = Replace((arr(i, 1)), "Not Applicable", "All Other")
Next i
Sheets("POS").Range("E2:E" & lr) = arr

arr = Sheets("POS").Range("F2:F" & lr)
For i = 1 To UBound(arr)
    arr(i, 1) = Replace((arr(i, 1)), "Single", "1")
Next i
Sheets("POS").Range("F2:F" & lr) = arr

arr = Sheets("POS").Range("G2:G" & lr)
For i = 1 To UBound(arr)
    arr(i, 1) = Replace((arr(i, 1)), "Total Brick & Mortar", "Brick & Mortar")
    arr(i, 1) = Replace((arr(i, 1)), "Total Ecommerce", "Ecommerce")
Next i
Sheets("POS").Range("G2:G" & lr) = arr

arr = Sheets("POS").Range("H2:H" & lr)
For i = 1 To UBound(arr)
    arr(i, 1) = Replace((arr(i, 1)), "$ Velocity - Weighted", "$ Velocity")
    arr(i, 1) = Replace((arr(i, 1)), "Unit Velocity - Weighted", "Unit Velocity")
    arr(i, 1) = Replace((arr(i, 1)), "% Distribution - Weighted", "% Distribution")
    arr(i, 1) = Replace((arr(i, 1)), "% of Stores Selling - Unweighted", "% of Stores Selling")
    arr(i, 1) = Replace((arr(i, 1)), "Avg # of Items Where Carried - Weighted", "Avg # of Items")
    arr(i, 1) = Replace((arr(i, 1)), "$ Velocity per Items Carried - Weighted", "$ Velocity")
    arr(i, 1) = Replace((arr(i, 1)), "Unit Velocity per Items Carried - Weighted", "Unit Velocity")
Next i
Sheets("POS").Range("H2:H" & lr) = arr
Application.ScreenUpdating = True
End Sub

Cheers,

Tony
 
Upvote 0
rlv01 said:
Instead of looping though each cell in the range, consider using the Range.Replace method. For example, replace this
VBA Code: 
    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
with this
VBA Code: 
    With Worksheets("POS").Range("B2:B" & lr)
        .Replace What:="Zebra Pen Corporation", Replacement:="Zebra"
        .Replace What:="Newell Brands", Replacement:="Newell"
        .Replace What:="Pilot Pen", Replacement:="Pilot"
    End With
Click to expand...
Thanks for your response. I modified the code as below. I am receiving Compile Error Next without For .

1645993661958.png


VBA Code: 
Sub ReplaceName()
'
    Application.ScreenUpdating = False
'
    Dim lr      As Long
    Dim cell    As Range
'
    lr = Worksheets("POS").Range("B" & Rows.Count).End(xlUp).Row
'
      With Worksheets("POS").Range("B2:B" & lr)
        .Replace What:="Zebra Pen Corporation", Replacement:="Zebra"
        .Replace What:="Newell Brands", Replacement:="Newell"
        .Replace What:="Pilot Pen", Replacement:="Pilot"
   Next
    With Worksheets("POS").Range("G2:G" & lr)
        .Replace What:="Total Brick & Mortar", Replacement:="Brick & Mortar"
        .Replace What:="Total Ecommerce", Replacement:="Ecommerce"
      Next
    With Worksheets("POS").Range("E2:E" & lr)
        .Replace What:="Not Applicable", Replacement:="All Other"
        .Replace What:="Not Specified", Replacement:="All Other"
        Next
    With Worksheets("POS").Range("H2:H" & lr)
        .Replace What:="$ Velocity - Weighted", Replacement:="$ Velocity"
        .Replace What:="Unit Velocity - Weighted", Replacement:="Unit Velocity"
        .Replace What:="% Distribution - Weighted", Replacement:="% Distribution"
        .Replace What:="% of Stores Selling - Unweighted", Replacement:="% of Stores Selling"
        .Replace What:="Avg # of Items Where Carried - Weighted", Replacement:="Avg # of Items"
        .Replace What:="$ Velocity per Items Carried - Weighted", Replacement:="$ Velocity"
        .Replace What:="Unit Velocity per Items Carried - Weighted", Replacement:="Unit Velocity"
      Next
    With Worksheets("POS").Range("F2:F" & lr)
        .Replace What:="Single", Replacement:="1"
 
    Next
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Staying with the Array approach, if your POS sheet does NOT contain formulas, the code can be written more efficiently as...

VBA Code: 
Sub ReplaceName3()
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
End Sub
 
Upvote 0
tonyyy said:
Another approach would be to do your replacements in an Array...

VBA Code: 
Sub ReplaceName2()
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:B" & lr)
For i = 1 To UBound(arr)
    arr(i, 1) = Replace((arr(i, 1)), "Pilot Pen", "Pilot")
Next i
Sheets("POS").Range("B2:B" & lr) = arr

arr = Sheets("POS").Range("E2:E" & lr)
For i = 1 To UBound(arr)
    arr(i, 1) = Replace((arr(i, 1)), "Not Applicable", "All Other")
Next i
Sheets("POS").Range("E2:E" & lr) = arr

arr = Sheets("POS").Range("F2:F" & lr)
For i = 1 To UBound(arr)
    arr(i, 1) = Replace((arr(i, 1)), "Single", "1")
Next i
Sheets("POS").Range("F2:F" & lr) = arr

arr = Sheets("POS").Range("G2:G" & lr)
For i = 1 To UBound(arr)
    arr(i, 1) = Replace((arr(i, 1)), "Total Brick & Mortar", "Brick & Mortar")
    arr(i, 1) = Replace((arr(i, 1)), "Total Ecommerce", "Ecommerce")
Next i
Sheets("POS").Range("G2:G" & lr) = arr

arr = Sheets("POS").Range("H2:H" & lr)
For i = 1 To UBound(arr)
    arr(i, 1) = Replace((arr(i, 1)), "$ Velocity - Weighted", "$ Velocity")
    arr(i, 1) = Replace((arr(i, 1)), "Unit Velocity - Weighted", "Unit Velocity")
    arr(i, 1) = Replace((arr(i, 1)), "% Distribution - Weighted", "% Distribution")
    arr(i, 1) = Replace((arr(i, 1)), "% of Stores Selling - Unweighted", "% of Stores Selling")
    arr(i, 1) = Replace((arr(i, 1)), "Avg # of Items Where Carried - Weighted", "Avg # of Items")
    arr(i, 1) = Replace((arr(i, 1)), "$ Velocity per Items Carried - Weighted", "$ Velocity")
    arr(i, 1) = Replace((arr(i, 1)), "Unit Velocity per Items Carried - Weighted", "Unit Velocity")
Next i
Sheets("POS").Range("H2:H" & lr) = arr
Application.ScreenUpdating = True
End Sub

Cheers,

Tony
Click to expand...
Thank you for your response, It worked.
 
Upvote 0
Dokat said:
Thanks for your response. I modified the code as below. I am receiving Compile Error Next without For .
Click to expand...
Replace all the lines saying Next with End With
 
Upvote 0
rlv01 said:
Instead of looping though each cell in the range, consider using the Range.Replace method. For example, replace this
VBA Code: 
    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
with this
VBA Code: 
    With Worksheets("POS").Range("B2:B" & lr)
        .Replace What:="Zebra Pen Corporation", Replacement:="Zebra"
        .Replace What:="Newell Brands", Replacement:="Newell"
        .Replace What:="Pilot Pen", Replacement:="Pilot"
    End With
Click to expand...

Dokat said:
Thanks for your response. I modified the code as below. I am receiving Compile Error Next without For .

View attachment 58863
Click to expand...
Keep in mind that the intent is to replace all the For...Next loops with a With .... End With structure. When you made your changes, you forgot to replace Next with End With
 
Upvote 0
rlv01 said:
Keep in mind that the intent is to replace all the For...Next loops with a With .... End With structure. When you made your changes, you forgot to replace Next with End With
Click to expand...
Thanks its working now.
 
Upvote 0
tonyyy said:
Staying with the Array approach, if your POS sheet does NOT contain formulas, the code can be written more efficiently as...

VBA Code: 
Sub ReplaceName3()
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
End Sub
Click to expand...
Thank for your help. This runs extremely efficient and fast.
 
Upvote 0
You must log in or register to reply here.

Similar threads

KlausW
  • Question
VBA code suddenly won't run
Replies
6
Views
361
KlausW
KlausW
KlausW
  • Question
VBA code does not run properly with formulas
Replies
0
Views
302
KlausW
KlausW
D
  • Question
Code is running too slow
Replies
2
Views
316
bebo021999
B
S
  • Question
Need code that adds multiple new rows to table to include a check box in column "L" for each new row
Replies
0
Views
356
sspatriots
S
M
  • Question
VBA Code - Run Code if cell value is not blank
Replies
0
Views
444
MHamid
M

Forum statistics

Threads
1,215,575
Messages
6,125,631
Members
449,241
Latest member
NoniJ

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top