How would you speed up this loop

J

JumboCactuar

Well-known Member
Joined
Nov 16, 2016
Messages
785
Office Version
  1. 365
Platform
  1. Windows
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

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

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.
Sort by date Sort by votes
I would use the .End(xlUp).Row on the dataset page lookup columns or use tables and calculations to do all of the above . . .
 
Upvote 0
CSmith said:
I would use the .End(xlUp).Row on the dataset page lookup columns or use tables and calculations to do all of the above . . .
Click to expand...

Not sure how i would do that with this.

I thought about writing the sheet data to arrays
then lookup the ItemCode but not sure how lookups work in arrays
 
Upvote 0
It is very hard to say without the actual data but this should work:
VBA Code: 
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
     
'Get SKU from ItemCode
        SKU = Application.WorksheetFunction.XLookup(ItemCode, myRange3.Columns(1), myRange3.Columns(2), "")
        If SKU = "" Then GoTo Continue
             
'Get ItemStatus from SKU
        ItemStatus = Application.WorksheetFunction.XLookup(SKU, myRange4.Columns(4), myRange4.Columns(5), "")
        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 = Application.WorksheetFunction.XLookup(SKU, myRange4.Columns(1), myRange4.Columns(2), 0)

        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
 
Upvote 0
the really fast way to do this is to use the Dictionary object instead of all the XLOOKUP . I was slightluy puzzled as to why you are looking up SKU in two different columns on shet4, That just doesn't mnake sense to me. SO I left that one!!
this is untested but should be super fast!!

VBA Code: 
Sub test()
lr = Sheet2.Range("A50000").End(xlUp).Row
'  add all the next few lines of code
inarr = Range(Cells(1, 1), Cells(lr, 8)) ' load all of the data columns A to H into an array
' load data from sheet 2 into a dictionary
With Worksheets("Sheet3")
lr3 = .Cells(Rows.Count, "A").End(xlUp).Row
in3 = .Range(.Cells(1, 1), .Cells(lr3, 2))
Dim Dic3 As Object
Set Dic3 = CreateObject("Scripting.dictionary")
For j = 1 To lr3
        Dic3(in3(i, 1)) = in3(i, 2)               ' Load Dictionary with Value in Column B
Next j
End With
 
With Worksheets("Sheet4")
lr4 = .Cells(Rows.Count, "A").End(xlUp).Row
in4 = .Range(.Cells(1, 1), .Cells(lr4, 5))  ' load columns at to E
Dim Dic4 As Object
Set Dic4 = CreateObject("Scripting.dictionary")
For j = 1 To lr4
        Dic4(in4(i, 1)) = in4(i, 2)               ' Load Dictionary with index into array in4 becaue we need to use it twice ( Note I didn't do this, see comment)
Next j
End With
 
' Now the re written part
 
 
 
    For i = 4 To lr
 
'        ItemCode = Sheet2.Range("F" & i)
'        CurrentAvail = Sheet2.Range("H" & i)
        ItemCode = inarr(i, 6)
        CurrentAvail = inarr(i, 8)
        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 Dic3.Exists(inarr(i, 1)) Then  ' check if element exists
         SKU = Dic3(inarr(i, 1)) ' Load output with dictionary value
         Else          ' if it not set to not found
         GoTo Continue
         End If
  
 '       If SKU = "" Then GoTo Continue
          
'Get ItemStatus from SKU
        ItemStatus = Application.WorksheetFunction.XLookup(SKU, Sheet4.Range("D:D"), Sheet4.Range("E:E"), "")
  ' slightly puzzled by this one because you seem to belooking up SKU  in column D as well as column A below, is this correct or necessary,
  ' becuase it would require loading another dictionary
   
        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 Dic4.Exists(SKU) Then  ' check if element exists
         CurrentStock = Dic4(SKU) ' Load output with dictionary value
         End If

        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

End Sub
Note you could combine this with the solution from flashbond to get the benefit from both solutions
 
Last edited:
Upvote 0
offthelip said:
the really fast way to do this is to use the Dictionary object instead of all the XLOOKUP . I was slightluy puzzled as to why you are looking up SKU in two different columns on shet4, That just doesn't mnake sense to me. SO I left that one!!
this is untested but should be super fast!!

VBA Code: 
Sub test()
lr = Sheet2.Range("A50000").End(xlUp).Row
'  add all the next few lines of code
inarr = Range(Cells(1, 1), Cells(lr, 8)) ' load all of the data columns A to H into an array
' load data from sheet 2 into a dictionary
With Worksheets("Sheet3")
lr3 = .Cells(Rows.Count, "A").End(xlUp).Row
in3 = .Range(.Cells(1, 1), .Cells(lr3, 2))
Dim Dic3 As Object
Set Dic3 = CreateObject("Scripting.dictionary")
For j = 1 To lr3
        Dic3(in3(i, 1)) = in3(i, 2)               ' Load Dictionary with Value in Column B
Next j
End With
 
With Worksheets("Sheet4")
lr4 = .Cells(Rows.Count, "A").End(xlUp).Row
in4 = .Range(.Cells(1, 1), .Cells(lr4, 5))  ' load columns at to E
Dim Dic4 As Object
Set Dic4 = CreateObject("Scripting.dictionary")
For j = 1 To lr4
        Dic4(in4(i, 1)) = in4(i, 2)               ' Load Dictionary with index into array in4 becaue we need to use it twice ( Note I didn't do this, see comment)
Next j
End With
 
' Now the re written part
 
 
 
    For i = 4 To lr
 
'        ItemCode = Sheet2.Range("F" & i)
'        CurrentAvail = Sheet2.Range("H" & i)
        ItemCode = inarr(i, 6)
        CurrentAvail = inarr(i, 8)
        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 Dic3.Exists(inarr(i, 1)) Then  ' check if element exists
         SKU = Dic3(inarr(i, 1)) ' Load output with dictionary value
         Else          ' if it not set to not found
         GoTo Continue
         End If
 
 '       If SKU = "" Then GoTo Continue
         
'Get ItemStatus from SKU
        ItemStatus = Application.WorksheetFunction.XLookup(SKU, Sheet4.Range("D:D"), Sheet4.Range("E:E"), "")
  ' slightly puzzled by this one because you seem to belooking up SKU  in column D as well as column A below, is this correct or necessary,
  ' becuase it would require loading another dictionary
  
        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 Dic4.Exists(SKU) Then  ' check if element exists
         CurrentStock = Dic4(SKU) ' Load output with dictionary value
         End If

        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

End Sub
Note you could combine this with the solution from flashbond to get the benefit from both solutions
Click to expand...

Thank you
Will give this a try

I was slightluy puzzled as to why you are looking up SKU in two different columns on shet4
Click to expand...

I have 2 sets of data on that sheet (Columns A + B) + (Columns D+E)
 
Upvote 0
Flashbond said:
It is very hard to say without the actual data but this should work:
VBA Code: 
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
   
'Get SKU from ItemCode
        SKU = Application.WorksheetFunction.XLookup(ItemCode, myRange3.Columns(1), myRange3.Columns(2), "")
        If SKU = "" Then GoTo Continue
           
'Get ItemStatus from SKU
        ItemStatus = Application.WorksheetFunction.XLookup(SKU, myRange4.Columns(4), myRange4.Columns(5), "")
        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 = Application.WorksheetFunction.XLookup(SKU, myRange4.Columns(1), myRange4.Columns(2), 0)

        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
Click to expand...
My code won't work, sorry. I just thought that I was working with ranges for a while.
 
Upvote 0
Working version of my code:
VBA Code: 
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(.Lookup(ItemCode, .Index(myRange3, 0, 1), .Index(myRange3, 0, 2)), "")
        If SKU = "" Then GoTo Continue
          
'Get ItemStatus from SKU
        ItemStatus = .IfError(.Lookup(SKU, .Index(myRange4, 0, 4), .Index(myRange4, 0, 5)), "")
        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 = .Lookup(SKU, .Index(myRange4, 0, 1), .Index(myRange4, 0, 2))
       
        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
 
Upvote 0
@Flashbond
thanks for you help with this

I was Stepping through the code and on this part:
VBA Code: 
        ItemStatus = .IfError(.Lookup(SKU, .Index(myRange4, 0, 4), .Index(myRange4, 0, 5)), "")
        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

If the SKU isn't in column D, it is returning '90' rather than blank. Not sure why
 
Upvote 0
JumboCactuar said:
@Flashbond
thanks for you help with this

I was Stepping through the code and on this part:
VBA Code: 
        ItemStatus = .IfError(.Lookup(SKU, .Index(myRange4, 0, 4), .Index(myRange4, 0, 5)), "")
        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

If the SKU isn't in column D, it is returning '90' rather than blank. Not sure why
Click to expand...
I didn't get it. It basically looking Sheet4 column D and returning column E result. If there isn't any, it should return empty.

EDIT: Ohh I think I know.. Lookup brings the closest number because of its nature.
 
Upvote 0
You must log in or register to reply here.

Similar threads

Agnarr
  • Question
VBA problem with creating new sheets
Replies
0
Views
368
Agnarr
Agnarr
A
  • Question
how to add my signature with images to macro
Replies
1
Views
180
Domenic
D
E
  • Question
Trying to improve quality of image on Email.
Replies
0
Views
60
Eric Penfold
E
S
  • Solved
Miscrosoft has Blocking The Macro Sometimes and disabling the macros
Replies
5
Views
423
NdNoviceHlp
NdNoviceHlp
S
  • Question
Scan Attendance
Replies
1
Views
292
Stewart11715
S

Forum statistics

Threads
1,215,266
Messages
6,123,962
Members
449,137
Latest member
yeti1016

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