VBA Index Marco can not auto fill data if the last row of Colum A is blank-CodePudding

I am having a issue to auto fill data from another sheet, I am trying to enter "sku" Value in Sheet(Report), then auto fill both "Store name" & "qty" from another Sheet(SOH). However, if the last row of the "store name" (Column A, Report Sheet) = Blank, this Marco will not working properly, otherwise it is working fine. Did I miss something? Any help would be greatly appreciated!!

Sub Fill_Report()
    Dim d, s As Long
    Dim sQTY As Double
    Dim dws, sws As Worksheet
   
    Set dws = ThisWorkbook.Worksheets("Report") 'Destination Sheet
    Set sws = ThisWorkbook.Worksheets("SOH")  'Source Sheet
    
    dlr = dws.Cells(Rows.Count, 1).End(xlUp).Row
    slr = sws.Cells(Rows.Count, 1).End(xlUp).Row

    For d = 2 To dlr
        For s = 2 To slr

            ssku = sws.Cells(s, "A:A").Value
            dsku = dws.Cells(d, "B:B").Value
        
            'Index qty from source
            sQTY = Application.IfError(Application.Index(Sheets("SOH").Range("A:Z"), _
                Application.Match(ssku, Sheets("Report").Range("B:B"), 0), 2), 0)
            
            'add title
            dws.Cells(1, 1).Value = "Sotre Name"
            dws.Cells(1, 2).Value = "sku"
            dws.Cells(1, 3).Value = "qty"

            If dsku = ssku Then
        
                dws.Cells(d, "A").Value = "ABC"
                dws.Cells(d, "C").Value = sQTY
                Exit For
            End If
        Next s
    Next d

End Sub

CodePudding user response：

Collections and Dictionaries are optimized for fast lookups. Consider using them over Match and Index.

Range("A1").CurrentRegion will select the entire range of contiguous cells.

Sub Fill_Report()
    Dim Quantities As New Collection
    
    Set Quantities = getSKUQuantity
    
    
    Dim Data As Variant
    Data = wsReport.Range("A1").CurrentRegion.Columns("B").Offset(1)
    
    Dim r As Long
    Dim QTY As Double
    
    For r = r To UBound(Data)
        On Error Resume Next
        QTY = Quantities(Data(r, 1))
        
        If Err.Number = 0 Then
            Data(r, 1) = QTY
        Else
            Data(r, 1) = ""
        End If
        On Error GoTo 0
    Next
    
    wsReport.Range("A1").CurrentRegion.Columns("C").Offset(1).Value = Data
End Sub

Function getSKUQuantity() As Collection
    Dim Data As Variant
    Data = wsSOH.Range("A1").CurrentRegion
    
    Dim Quantities As New Collection
    Dim r As Long
    
    For r = 2 To UBound(Data)
        On Error Resume Next
        
        If Err.Number = 0 Then
            Quantities.Add Data(r, 2), CStr(Data(r, 1))
        Else
            Debug.Print "Duplicate SKU: ", Data(r, 1)
        End If
        On Error GoTo 0
    Next
    Set getSKUQuantity = Quantities
    
End Function

Function wsSOH() As Worksheet
    Set wsSOH = ThisWorkbook.Sheets("SOH")
End Function

Function wsReport() As Worksheet
    Set wsReport = ThisWorkbook.Sheets("Report")
End Function