Reduce the time for code run

-=NO=-

New Member
Joined
May 9, 2011
Messages
27
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Hello guys;

Please advise regarding reduce the time for the below code, noted that the total row in sheet is about 40,000 row and the time it takes the code to finish more than 20 minutes.

VBA Code:
Private Sub cmdPO_Click()
'Prepare PO sheet
SpeedOn
Dim zrng, rng As Range
Dim LR As Long

On Error Resume Next
With Sheets("PO")
LR = .Range("B65536").End(xlUp).Row
.Range("AA3:AA" & LR) = vbNullString
.Range("AE3:AG" & LR) = vbNullString

For Each rng In .Range("B3:B" & LR)
    Set zrng = Sheets("PR").Columns(19).Find(rng, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
        If Not zrng Is Nothing Then rng.Offset(0, 25) = zrng.Offset(0, -17)
        
        If rng.Offset(0, -1) = "ASEER" Or rng.Offset(0, -1) = "DAMMAM" Then
            rng.Offset(0, 29) = rng.Offset(0, 5)
        Else
            rng.Offset(0, 29) = Left(rng.Offset(0, 2), 2)
        End If
        
        Set zrng = Sheets("CTG. List").Columns(1).Find(rng.Offset(0, 29), LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
            If Not zrng Is Nothing Then
                rng.Offset(0, 30) = zrng.Offset(0, 1)
                rng.Offset(0, 31) = zrng.Offset(0, 2)
            Else
                rng.Offset(0, 30) = "": rng.Offset(0, 31) = ""
            End If
Next rng
End With
End Sub
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
What exactly is "SpeedOn"?

You can also speed up the code by placing this row at the beginning of your code to suppress all screen updating:
VBA Code:
Application.ScreenUpdating = False
Then turn it back on just before the "End Sub" line like this:
VBA Code:
Application.ScreenUpdating =True
 
Upvote 0
What exactly is "SpeedOn"?

You can also speed up the code by placing this row at the beginning of your code to suppress all screen updating:
VBA Code:
Application.ScreenUpdating = False
Then turn it back on just before the "End Sub" line like this:
VBA Code:
Application.ScreenUpdating =True
Thanks Joe4, I'm already using it in "SpeedOn" as below, but is there any way else?

VBA Code:
Option Explicit
 
Public glb_origCalculationMode As Integer
 
Sub SpeedOn(Optional StatusBarMsg As String = "Running macro...")
    glb_origCalculationMode = Application.Calculation
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
        .Cursor = xlWait
        .StatusBar = StatusBarMsg
        .EnableCancelKey = xlErrorHandler
    End With
End Sub
 
Upvote 0
The only thing I can think of is to see if there is a way to rewrite your code, maybe try to avoid using loops.
But without seeing your data and having an explanation of what your code is supposed to be doing, I cannot really say.
Even knowing all that, I may not be able to have a better suggestion for you (I rely on loops a bit more than I probably should too!).
 
Upvote 0
The only thing I can think of is to see if there is a way to rewrite your code, maybe try to avoid using loops.
But without seeing your data and having an explanation of what your code is supposed to be doing, I cannot really say.
Even knowing all that, I may not be able to have a better suggestion for you (I rely on loops a bit more than I probably should too!).
I have three sheets; the 1st is the target sheet "PO" and the 2nd and 3rd are the source ones "PR" & "CTG. List"

KPI-Jeddah v8.xlsm
ABCDAAABACADAEAFAG
2BRANCHPO NUMBERORDER DATEITEM CODELINKED PR NUMBERPR DATETENDER?COMPLIANCE?CODE SUFFIXCATEGORY LEVELSUB CATEGORY LEVEL
3JEDDAH14009656328-Feb-21PR-F-000064
4JEDDAH14009656328-Feb-21PR-L-000002
5JEDDAH14009656328-Feb-21PR-P-000048
6JEDDAH14009655928-Feb-21P07ACUVA1D
7JEDDAH14009655928-Feb-21P11BOTOX1J
8JEDDAH14009655928-Feb-21P07FMLLI1DC
9JEDDAH14009655928-Feb-21P11HEPAT4J
10JEDDAH14009655928-Feb-21P09NEURO6J
11JEDDAH14009655928-Feb-21PP03PRADA1C
PO
Cells with Data Validation
CellAllowCriteria
AC3:AC9519ListYes,No
AD3:AD9519ListComply,Not comply


KPI-Jeddah v8.xlsm
ABST
2BRANCHPR NUMBERPO NUMBERON HAND STOCK
3JEDDAH110157914140096594
4JEDDAH110157914140096594
5JEDDAH110157859140096663
6JEDDAH110157857140096664
7JEDDAH110157857140096664
8JEDDAH110157854140096665
9JEDDAH110157854140096665
10JEDDAH110157854140096665
11JEDDAH110157844140096559
12JEDDAH110157844140096559
PR


KPI-Jeddah v8.xlsm
ABC
1SuffixCategorySub-Category
2FAFixed AssetsFixed Assets
3MSMedicalMedical Supplies
4DNMedicalDental Supplies
5LBMedicalLab Supplies
6XRMedicalX-Rays Supplies
7HKNon MedicalHousekeeping
8UTNon MedicalUtilization
9MKNon MedicalMarketing & Advertisment
10ADNon MedicalMarketing & Advertisment
CTG. List
 
Upvote 0
It looks like you are just looking up data from other sheets.
Can't you just use VLOOKUP formulas instead? That would be much more efficient than using loops, as you can apply the formula to the whole range at once in a single line of code.
Then if you want to hard-code the values instead of using formulas, you can do that in another single line of code like this:
Rich (BB code):
Range(some range).Value = Range(some range).Value
 
Upvote 0
Thanks Joe4, but the sheet do another calculations, not only this, so I have to go with vba code.

Please if you can illustrate this option as i didn't catch your point
VBA Code:
Range([I]some range[/I]).Value = Range([I]some range[/I]).Value
 
Upvote 0
Thanks Joe4, but the sheet do another calculations, not only this, so I have to go with vba code.
You can still use VBA! Just have Excel post the VLOOKUP formulas. If you are not sure what those formulas should look like in VBA, that is OK, you can actually let Excel figure it out for you!
Just turn on the Macro Recorder, and record yourself manually entering the VLOOKUP formula, and it wll record the code that you need for that part.

Please if you can illustrate this option as i didn't catch your point
I will show you a real simple example.

Say on Sheet1, we have data that looks like this, where we want to look up the age for a bunch of people.
1617363729363.png


And on Sheet2 is our lookup table that looks like this:
1617363801339.png


Then, if we turn on the Macro Recorder, and manually enter a VLOOKUP formula in cell B2 on Sheet1 to look up the age, it will record code that looks something like this:
VBA Code:
Sub Macro1()
'
' Macro1 Macro
'

'
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Sheet2!RC[-1]:R[5]C,2,0)"
    Range("B3").Select
End Sub
The formula part is what we are interested in. That is the what entering a VLOOKUP formula via VBA would look like.
However, the range is "hard-coded" in there. We do not want that, because we do not know how big the range may be. We can use "current region" which will dynamically grab the full size of the table (with "current region", just pick any cell in your table, and current region will will select the complete contigous range, all the connecting rows and columns).

If we grab the current region and then name that range, we can use that named range in our VLOOKUP formula instead of the hard-coded range.

After we enter the formulas, we can overwrite them with the hard-coded values of those formulas, so we are not left with any formulas, and our workbook should run more efficiently.

So, putting all that code together, it would look something like this:
VBA Code:
Sub MyMacro()

    Dim lr As Long
    
    Application.ScreenUpdating = False
    
'   Find last row in column A on Sheet1 with data
    lr = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row

'   Use Current Region to get dynamic range on sheet 2
    ActiveWorkbook.Names.Add Name:="MyRange", RefersToR1C1:=Sheets("Sheet2").Range("A1").CurrentRegion

'   Enter formulas on in column B sheet1 from row 2 to end
    Sheets("Sheet1").Range("B2:B" & lr).FormulaR1C1 = "=VLOOKUP(RC[-1],MyRange,2,0)"
    
'   Turn formulas into hard-coded values
    Sheets("Sheet1").Range("B2:B" & lr).Value = Sheets("Sheet1").Range("B2:B" & lr).Value

    Application.ScreenUpdating = True
    
End Sub
Note that I commented each step to explain what it is doing.

You should be able to apply this same sort of logic to your workbook, which should hopefully improve performance.
 
Upvote 0
You can still use VBA! Just have Excel post the VLOOKUP formulas. If you are not sure what those formulas should look like in VBA, that is OK, you can actually let Excel figure it out for you!
Just turn on the Macro Recorder, and record yourself manually entering the VLOOKUP formula, and it wll record the code that you need for that part.


I will show you a real simple example.

Say on Sheet1, we have data that looks like this, where we want to look up the age for a bunch of people.
View attachment 35802

And on Sheet2 is our lookup table that looks like this:
View attachment 35803

Then, if we turn on the Macro Recorder, and manually enter a VLOOKUP formula in cell B2 on Sheet1 to look up the age, it will record code that looks something like this:
VBA Code:
Sub Macro1()
'
' Macro1 Macro
'

'
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Sheet2!RC[-1]:R[5]C,2,0)"
    Range("B3").Select
End Sub
The formula part is what we are interested in. That is the what entering a VLOOKUP formula via VBA would look like.
However, the range is "hard-coded" in there. We do not want that, because we do not know how big the range may be. We can use "current region" which will dynamically grab the full size of the table (with "current region", just pick any cell in your table, and current region will will select the complete contigous range, all the connecting rows and columns).

If we grab the current region and then name that range, we can use that named range in our VLOOKUP formula instead of the hard-coded range.

After we enter the formulas, we can overwrite them with the hard-coded values of those formulas, so we are not left with any formulas, and our workbook should run more efficiently.

So, putting all that code together, it would look something like this:
VBA Code:
Sub MyMacro()

    Dim lr As Long
   
    Application.ScreenUpdating = False
   
'   Find last row in column A on Sheet1 with data
    lr = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row

'   Use Current Region to get dynamic range on sheet 2
    ActiveWorkbook.Names.Add Name:="MyRange", RefersToR1C1:=Sheets("Sheet2").Range("A1").CurrentRegion

'   Enter formulas on in column B sheet1 from row 2 to end
    Sheets("Sheet1").Range("B2:B" & lr).FormulaR1C1 = "=VLOOKUP(RC[-1],MyRange,2,0)"
   
'   Turn formulas into hard-coded values
    Sheets("Sheet1").Range("B2:B" & lr).Value = Sheets("Sheet1").Range("B2:B" & lr).Value

    Application.ScreenUpdating = True
   
End Sub
Note that I commented each step to explain what it is doing.

You should be able to apply this same sort of logic to your workbook, which should hopefully improve performance.

Thanks Joe4; It works like charm but can you please advise how can I convert the below code with the same technique.

Excel Formula:
 For Each rng In .Range("B3:B" & LR)
Set zrng1 = Sheets("PO").Columns(2).Find(rng.Offset(0, 5), LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
        If Not zrng1 Is Nothing Then
            If zrng1.Offset(0, 2) = rng.Offset(0, 1) Then
                rng.Offset(0, 25) = "Included in month statistics"
            Else
                rng.Offset(0, 25) = ""
            End If
        Else
            rng.Offset(0, 25) = ""
       End If
next rng
 
Upvote 0
Thanks Joe4; It works like charm but can you please advise how can I convert the below code with the same technique.
I don't see that in your original code, and when I try to run it against the sample data you provided, it doesn't seem to do anything.
Can you explain what it is supposed to be doing?
Can you post your entire updated code (so I can see what sections of code are running first)?
 
Upvote 0

Forum statistics

Threads
1,213,510
Messages
6,114,040
Members
448,543
Latest member
MartinLarkin

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