Home > Software engineering >  Find Next Method Slow on Last Instance only
Find Next Method Slow on Last Instance only

Time:04-25

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
  • Related