How would you speed up this loop

[JumboCactuar]

Hi,
I wrote this loop and if the Last Row(LR) is quite large (1000+) it is slow to process.
I am guessing due to the xlookups in using, can anyone suggest anything to speed that up

Maybe it would help loading the lookup ranges into an array and search that?

thank you

LR = Sheet2.Range("A50000").End(xlUp).Row
    For i = 4 To LR
   
        ItemCode = Sheet2.Range("F" & i)
        CurrentAvail = Sheet2.Range("H" & i)
        If CurrentAvail = "Permanently unavailable" Then GoTo Continue
       
'Get SKU from ItemCode
        SKU = Application.WorksheetFunction.XLookup(ItemCode, Sheet3.Range("A:A"), Sheet3.Range("B:B"), "")
        If SKU = "" Then GoTo Continue
               
'Get ItemStatus from SKU
        ItemStatus = Application.WorksheetFunction.XLookup(SKU, Sheet4.Range("D:D"), Sheet4.Range("E:E"), "")
        If ItemStatus = "80" Or ItemStatus = "90" Then
            Sheet2.Range("J" & i) = "Permanently unavailable"
            Sheet2.Range("K" & i) = Format(Date + 1, "YYYY/MM/DD")
            GoTo Continue
        End If
       
'Get Current Stock available from SKU
        CurrentStock = Application.WorksheetFunction.XLookup(SKU, Sheet4.Range("A:A"), Sheet4.Range("B:B"), 0)

        If CurrentAvail = "Available" And CurrentStock > 0 Then GoTo Continue
        
        If CurrentAvail = "Available" And CurrentStock = 0 Then
            Sheet2.Range("J" & i) = "Temporarily unavailable"
            Sheet2.Range("K" & i) = Format(Date + 1, "YYYY/MM/DD")
            Sheet2.Range("L" & i) = Format(Date + 31, "YYYY/MM/DD")
            GoTo Continue
        End If
       
        If CurrentAvail = "Temporarily unavailable" And CurrentStock > 0 Then
            Sheet2.Range("J" & i) = "Available"
            GoTo Continue
        End If
       
        If CurrentAvail = "Temporarily unavailable" And CurrentSOH = 0 Then
            Sheet2.Range("J" & i) = "Temporarily unavailable"
            Sheet2.Range("L" & i) = Format(Date + 31, "YYYY/MM/DD")
            GoTo Continue
        End If
       
Continue:
    Next i

 

[Legacy 143009]

This should do the trick:

Sub test()
  Dim myRange2 As Variant, myRange3 As Variant, myRange4 As Variant
 
  myRange2 = Sheet2.Range("F4:L" & Sheet2.Cells(Rows.Count, "A").End(xlUp).Row)
  myRange3 = Intersect(Sheet3.UsedRange, Sheet3.Range("A:B"))
  myRange4 = Intersect(Sheet4.UsedRange, Sheet4.Range("A:E"))
 
    For i = 1 To UBound(myRange2)
        ItemCode = myRange2(i, 1)
        CurrentAvail = myRange2(i, 3)
        If CurrentAvail = "Permanently unavailable" Then GoTo Continue
        With Application
'Get SKU from ItemCode
        SKU = .IfError(.Index(myRange3, .Match(ItemCode, .Index(myRange3, 0, 1), 0), 2), "") 'Match the first column (A) of Sheet3, return the second column (B) of Sheet3
        If SKU = "" Then GoTo Continue
        
'Get ItemStatus from SKU
        ItemStatus = .IfError(.Index(myRange4, .Match(SKU, .Index(myRange4, 0, 4), 0), 5), "") 'Match the fourth column (D) of Sheet4, return the fifth column (E) of Sheet4
        If ItemStatus = "80" Or ItemStatus = "90" Then
            myRange2(i, 5) = "Permanently unavailable"
            myRange2(i, 6) = Format(Date + 1, "YYYY/MM/DD")
            GoTo Continue
        End If
    
'Get Current Stock available from SKU
        CurrentStock = .Index(myRange4, .Match(SKU, .Index(myRange4, 0, 1), 0), 2) 'Match the first column (A) of Sheet4, return the second column (B) of Sheet4
        End With
      
        If CurrentAvail = "Available" And CurrentStock > 0 Then GoTo Continue
 
        If CurrentAvail = "Available" And CurrentStock = 0 Then
            myRange2(i, 5) = "Temporarily unavailable"
            myRange2(i, 6) = Format(Date + 1, "YYYY/MM/DD")
            myRange2(i, 7) = Format(Date + 31, "YYYY/MM/DD")
            GoTo Continue
        End If
 
        If CurrentAvail = "Temporarily unavailable" And CurrentStock > 0 Then
            myRange2(i, 5) = "Available"
            GoTo Continue
        End If
 
        If CurrentAvail = "Temporarily unavailable" And CurrentSOH = 0 Then
            myRange2(i, 5) = "Temporarily unavailable"
            myRange2(i, 7) = Format(Date + 31, "YYYY/MM/DD")
            GoTo Continue
        End If
 
Continue:
    Next i
    Sheet2.Range("F4").Resize(UBound(myRange2), UBound(myRange2, 2)) = myRange2
End Sub

 

[JumboCactuar]

@Flashbond
Thankyou that worked

Only other thing was this:

Where the SKU isn't in the list as there was no error handling on that line.
Fixed with

CurrentStock = .IfError(.Index(myRange4, .Match(SKU, .Index(myRange4, 0, 1), 0), 2), 0)

 

[Legacy 143009]

Yeah, that was not in your original code so i didn't add it. Happy to hear that worked!

How about the speed? Is it any better?

 

[JumboCactuar]

Yeah, that was not in your original code so i didn't add it. Happy to hear that worked!

How about the speed? Is it any better?

currently debugging as it gets stuck on "excel not responding"


My dataset is:
myRange2 - 4878 rows
myRange3 - 20000 rows
myRange4 - 30000 rows

where my code would take roughly 2 minutes

 

[Legacy 143009]

Strange... That should be way faster than dealing with worksheets and xlookup.

 

[JumboCactuar]

Strange... That should be way faster than dealing with worksheets and xlookup.

Ye its freezing up like it would do with a continuous loop

maybe something to do with that?

edit: no that as i did a debug.print Ubound(myRange2) and it returns correctly

 

[Legacy 143009]

Whattt??? It doesn't make any sense.. Very strange indeed... Ok modify that line like this:

myRange2 = Sheet2.Range("F4:L" & Sheet2.UsedRange.Rows.Count)

But I don't guarantee it will be the same size as column A.

Edit: oh ok..

 

[Legacy 143009]

Make a copy of your file. In the copied file, delete the rows after 100 in Sheet2. Try again. At least we can be sure at it is working.

 

[JumboCactuar]

Make a copy of your file. In the copied file, delete the rows after 100 in Sheet2. Try again. At least we can be sure at it is working.

I left the code running and it did eventually complete

But it took 9 minutes:

After deleting everything in Sheet2 after row 100 it takes 9 seconds

 

[Legacy 143009]

Surprising that it is slower than dealing with actual sheets and worksheet functions. Maybe it is better to use dictionaries. I am not that experienced with dictionaries. I can work for it or you can wait for another answer.