Excel Forum

Code: Select all

Sub Test0()
    Dim rall As Range, r As Range
    Dim arr(9999, 5) As Variant, i As Integer
    Dim cdt As String, sumOPD As Long, sumIPD As Long, sumQty As Long
    Dim lstl0 As Integer, lstl1 As Integer, lstl2 As Integer
    
    cdt = Worksheets("Display").Range("l7")(1).Value
    With Worksheets("Data")
        Set rall = .Range("a2", .Range("a" & .Rows.Count).End(xlUp))
        For Each r In rall
            If r.Value = cdt Then
                arr(i, 0) = r.Offset(0, 2).Value
                arr(i, 1) = ""
                arr(i, 2) = ""
                arr(i, 3) = r.Offset(0, 5).Value
                arr(i, 4) = r.Offset(0, 6).Value
                arr(i, 5) = r.Offset(0, 7).Value
                sumQty = sumQty + arr(i, 3)
                sumOPD = sumOPD + arr(i, 4)
                sumIPD = sumIPD + arr(i, 5)
                i = i + 1
            End If
        Next r
    End With
    If i > 0 Then
        With Worksheets("Display")
            lstl1 = .Range("c" & .Rows.Count).End(xlUp).Offset(-1, 0).Row - 1
            .Range("c12:h" & lstl1).ClearContents
            .Range("c12").Resize(i).EntireRow.Insert
            .Range("c12").Resize(i, 6).Value = arr
            lstl2 = .Range("c" & .Rows.Count).End(xlUp).Row
            .Cells(lstl2, "f").Value = sumQty
            .Cells(lstl2, "g").Value = sumOPD
            .Cells(lstl2, "h").Value = sumIPD
            lstl0 = .Range("c" & .Rows.Count).End(xlUp).Offset(-1, 0).Row
            lstl1 = .Range("c" & lstl0).End(xlUp).Row
            .Range("c" & lstl1 + 1).Resize(lstl0 - lstl1 - 1).EntireRow.Delete
        End With
    End If
End Sub