Countif and SUMIF using dictionary from another sheet

[Francease]

I'm trying to use dictionary for 3 different columns with COUNTIF and SUMIF getting the value from another sheet. I'm having a hard time getting the right code to get the value from another sheet, below is my currently using code. Any help will do thanks.

Transact Sheet

Invoice Sheet

Sub CTotals()
    
    Dim arr, ws, ws2, rng As Range, keyCols, valueCol As Long, destCol As Long, i As Long, frm As String, sep As String
    Dim t, dict, arrOut(), arrValues(), v, tmp, n As Long
    
    keyCols = 2  
    valueCol = 6            
    destCol = 4           
    
    t = Timer
    
    Set ws = ThisWorkbook.Worksheets("Transact")
    Set ws2 = ThisWorkbook.Worksheets("Invoice")
    Set rng = ws.Range("A1").CurrentRegion
    Set rng2 = ws2.Range("A6").CurrentRegion
    n = rng.Rows.Count - 1
    n2 = rng2.Rows.Count - 1
    Set rng = rng.Offset(1, 0).Resize(n) 
    Set rng2 = rng2.Offset(1, 0).Resize(n) 
 
   
    For i = 2 To (keyCols)
        frm = frm & rng2.Columns(keyCols).Address
    Next i
    
    arr = ws.Evaluate(frm) 
    arrValues = rng.Columns(valueCol).Value  
    ReDim arrOut(1 To n, 1 To 1)           
    
    Set dict = CreateObject("scripting.dictionary")
  
   
    For i = 1 To n
        v = arr(i, 1)
        If Not dict.exists(v) Then dict(v) = Array(0, 0)
        tmp = dict(v)
        tmp(0) = tmp(0) + 1               
        tmp(1) = tmp(1) + arrValues(i, 1) 
        dict(v) = tmp                   
    Next i
    
  
    For i = 1 To n
        arrOut(i, 1) = dict(arr(i, 1))(1)                      
       
    Next i
    
    rng2.Columns(destCol).Value = arrOut
    
    Debug.Print "Checked " & n & " rows in " & Timer - t & " secs"

End Sub

 

[igold]

Welcome to the MrExcel Forum. Is this close to what you are looking for. Please note that I took the names of the worksheets from what you have posted ("Transact Sheet" & "Invoice Sheet"). If these are not correct please change match your data.

Sub cTotals()

    Dim arr, arr2, arr3
    Dim wsTS As Worksheet: Set wsTS = Worksheets("Transact Sheet")
    Dim wsIS As Worksheet: Set wsIS = Worksheets("Invoice Sheet")
    Dim x As Long, i As Long, a As Long, c As Long, ct As Long
    Dim GIVMM As Single, MSU As Single, Cases As Single
        
    arr = wsTS.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
    wsIS.Range("B6").Resize(UBound(arr3, 1), UBound(arr3, 2)) = arr3
    
End Sub

 

[Francease]

Wow great it works! But I have another problem, what if I already have set of customer codes in Invoice sheet that I want to look for?

 

[igold]

I am glad that it works for you. Thanks for the feedback.

Please mark the post that answered your question as the solution to help future readers. Little check mark icon right side of the post.

I do not understand your question.

 

[Francease]

For example I already have these customer code list in Invoice sheet instead of getting the unique customer code in transact sheet.

 

[igold]

So you would want to retrieve the information from the "Transact" Sheet for those Customer Codes only...

 

[igold]

How about this...

Sub CTotals()

    Dim arr, arr2, arr3
    Dim wsTS As Worksheet: Set wsTS = Worksheets("Transact Sheet")
    Dim wsIS As Worksheet: Set wsIS = Worksheets("Invoice Sheet")
    Dim x As Long, i As Long, a As Long, c As Long, ct As Long, lRow As Long
    Dim GIVMM As Single, MSU As Single, Cases As Single
        
    lRow = wsIS.Range("B6").End(xlDown).Row
    arr = wsIS.Range("B6:B" & lRow)
    arr2 = wsTS.Range("B2:H" & Cells(Rows.Count, 2).End(xlUp).Row)
    ReDim arr3(1 To UBound(arr), 1 To 7)
    c = 1: ct = 1
    For i = 1 To UBound(arr)
        For a = 1 To UBound(arr2)
            If arr2(a, 1) = arr(i, 1) Then
                arr3(i, c) = arr(i, 1)
                arr3(i, c + 1) = ct
                ct = ct + 1
                GIVMM = GIVMM + arr2(a, 5)
                arr3(i, c + 2) = GIVMM
                MSU = MSU + arr2(a, 6)
                arr3(i, c + 3) = MSU
                Cases = Cases + arr2(a, 7)
                arr3(i, c + 4) = Cases
            End If
        Next
        ct = 1: GIVMM = 0: MSU = 0: Cases = 0
    Next
    wsIS.Range("B6").Resize(UBound(arr3, 1), UBound(arr3, 2)) = arr3
    
End Sub