all.
I'm running this code:
Sub ISN_Flyer_Performance()
Dim FlyerSh As Worksheet
Dim QlikSh As Worksheet
Dim SKURng As Range
Dim QlikSKURng As Range
Dim SKU As Range
Dim qlr As Long
Dim QlikSKU As Range
Dim TotalSales As Double
Dim FirstQlikSku As Range
Set FlyerSh = ActiveSheet
i = 2
lr = FlyerSh.Range("A" & Rows.Count).End(xlUp).Row
Set QlikSh = Application.InputBox("Click any cell on the Qlikview Sheet you want to lookup against", "Find Qlikview Sheet", Type:=8).Worksheet
qlr = QlikSh.Range("A" & Rows.Count).End(xlUp).Row
Set QlikSKURng = Range(Cells(2, QlikSh.Rows(1).Find(What:="Item Number", LookAt:=xlWhole).Column), Cells(qlr, QlikSh.Rows(1).Find(What:="Item Number", LookAt:=xlWhole).Column))
Set SKURng = Range(FlyerSh.Cells(i, 1), FlyerSh.Cells(lr, 1))
Set SKU = FlyerSh.Cells(i, 1)
For Each SKU In SKURng
Set QlikSKU = QlikSKURng.Find(What:=SKU.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If QlikSKU Is Nothing Then
SKU.Offset(0, 2).Value = 0
GoTo NextSku
Else
TotalSales = QlikSKU.Offset(0, 5).Value
Set FirstQlikSku = QlikSKU
Do
Set QlikSKU = QlikSKURng.FindNext(QlikSKU)
If QlikSKU.Address = FirstQlikSku.Address Then Exit Do
TotalSales = TotalSales QlikSKU.Offset(0, 5).Value
Loop
SKU.Offset(0, 2) = TotalSales
End If
NextSku:
Next SKU
End Sub
It's essentially like an XLookup, where it gets the thing to seach on one workbook, then finds it on a second, sends the value back to the first one, and moves on to the next item. I'd use an XLookup, but unfortunately, my sheet will always have duplicates, and I need to count both.
So I'm using this findnext loop to loop through a range (QlikSKURange) which has about 16k rows. The findNext is reasonably quick, like less than a second, EXCEPT the last instance when it goes back to the beginning and finds the first instance again. That instance can take over ten seconds.
Any idea why that might be?
Let me know if you need more info about the code.
I tried to just "Find" after the current iteration, instead of find next, and it has the same slow down.
CodePudding user response:
VBA Lookup Using the Find Method
- This is just the basic idea. There are many flaws e.g. if you cancel the input box, if you select a 'wrong' worksheet (e.g. column header not found), if there are error values, blank cells, etc.
Option Explicit
Sub ISN_Flyer_Performance()
' Flyer
Dim fws As Worksheet: Set fws = ActiveSheet ' improve!
Dim fLR As Long: fLR = fws.Range("A" & fws.Rows.Count).End(xlUp).Row
Dim frg As Range
Set frg = fws.Range(fws.Cells(2, "A"), fws.Cells(fLR, "A"))
'Debug.Print fws.Name, fLR, frg.Address
' Qlikview
Dim qws As Worksheet: Set qws = Application.InputBox( _
"Click any cell on the Qlikview Sheet you want to lookup against", _
"Find Qlikview Sheet", Type:=8).Worksheet
Dim qLR As Long: qLR = qws.Range("A" & qws.Rows.Count).End(xlUp).Row
Dim qC As Long
With qws.Rows(1) ' assuming that "Item Number" is surely in the first row
qC = .Find("Item Number", .Cells(.Cells.Count), _
xlFormulas, xlWhole).Column
End With
Dim qrg As Range
Set qrg = qws.Range(qws.Cells(2, qC), qws.Cells(qLR, qC))
'Debug.Print qws.Name, qLR, qC, frg.Address
Application.ScreenUpdating = False
Dim fCell As Range
Dim qCell As Range
Dim qFirstAddress As String
Dim TotalSales As Double
' Loop.
For Each fCell In frg.Cells
Set qCell = qrg.Find(fCell.Value, qrg.Cells(qrg.Cells.Count), _
xlFormulas, xlWhole)
If qCell Is Nothing Then
fCell.Offset(0, 2).Value = 0
Else
qFirstAddress = qCell.Address
Do
TotalSales = TotalSales qCell.Offset(0, 5).Value
Set qCell = qrg.FindNext(qCell)
Loop Until qCell.Address = qFirstAddress
fCell.Offset(0, 2).Value = TotalSales
TotalSales = 0
End If
Next fCell
Application.ScreenUpdating = True
MsgBox "Lookup done.", vbInformation
End Sub