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.
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