Getting only the values base on a list

[Francease]

Using this code below gives me a result of a unique customer codes base on Calculation sheet. However, I want to get my result base on the list that I have in Solution Sheet. Also want to run the macro in button inside Solution sheet. Any help will be appreciated.

Calculation Sheet

Solution Sheet

Public Sub cTotal()

    Dim arr, arr2, arr3
    Dim Calc As Worksheet: Set Calc = Worksheets("Calculation")
    Dim Sol As Worksheet: Set Sol = Worksheets("Solution")
    Dim x As Long, i As Long, a As Long, c As Long, ct As Long
    Dim GIVMM As Single, MSU As Double, Cases As Double
        
    arr = Calc.Range("B2:H" & Cells(Rows.Count, 1).End(xlUp).Row)
    arr2 = arr
    
    With CreateObject("Scripting.Dictionary")
    For x = LBound(arr) To UBound(arr)
        If Not IsMissing(arr(x, 1)) Then .Item(arr(x, 1)) = 1
    Next
    arr = .Keys
    End With
    
    ReDim arr3(1 To UBound(arr) + 1, 1 To 7)
    c = 1: ct = 1
    For i = 0 To UBound(arr)
        For a = 1 To UBound(arr2)
            If arr2(a, 1) = arr(i) Then
                arr3(i + 1, c) = arr(i)
                arr3(i + 1, c + 1) = ct
                ct = ct + 1
                GIVMM = GIVMM + arr2(a, 5)
                arr3(i + 1, c + 2) = GIVMM
                MSU = MSU + arr2(a, 6)
                arr3(i + 1, c + 3) = MSU
                Cases = Cases + arr2(a, 7)
                arr3(i + 1, c + 4) = Cases
            End If
        Next
        ct = 1: GIVMM = 0: MSU = 0: Cases = 0
    Next
    Sol.Range("B6").Resize(UBound(arr3, 1), UBound(arr3, 2)) = arr3
End Sub

 

[Alex Blakenburg]

See if this works for you.

Public Sub cTotal_Mod()

    Dim calcArr, solArr, arr3
    Dim Calc As Worksheet: Set Calc = Worksheets("Calculation")
    Dim Sol As Worksheet: Set Sol = Worksheets("Solution")
    Dim x As Long, i As Long, a As Long, c As Long, ct As Long
    Dim GIVMM As Single, MSU As Double, Cases As Double
    Dim CustCode As String
    Dim solDict As Object
        
    calcArr = Calc.Range("A2:H" & Calc.Cells(Rows.Count, "A").End(xlUp).Row)
    solArr = Sol.Range("B6:F" & Sol.Cells(Rows.Count, "B").End(xlUp).Row)
    
    Set solDict = CreateObject("Scripting.Dictionary")
    For x = 1 To UBound(solArr)
        solDict(solArr(x, 1)) = x
    Next

    For i = 1 To UBound(calcArr)
        CustCode = calcArr(i, 2)
        GIVMM = calcArr(i, 6)
        MSU = calcArr(i, 7)
        Cases = calcArr(i, 8)
        
        If solDict.exists(CustCode) Then
            solArr(solDict(CustCode), 2) = solArr(solDict(CustCode), 2) + 1
            solArr(solDict(CustCode), 3) = solArr(solDict(CustCode), 3) + GIVMM
            solArr(solDict(CustCode), 4) = solArr(solDict(CustCode), 4) + MSU
            solArr(solDict(CustCode), 5) = solArr(solDict(CustCode), 5) + Cases
        End If
    Next i

    Sol.Range("B6").Resize(UBound(solArr, 1), UBound(solArr, 2)) = solArr
End Sub

 

[Francease]

Thanks you very much! This is what exactly what I was looking for.

 

[Alex Blakenburg]

You're welcome. Glad I could help.