VBA Count of unique values with a second criteria

Question

I have hit a roadblock trying to think through how I might write the VBA code that counts the number of unique order numbers and and whether the order status is open or closed for each salesperson.

I am working on writing the VBA that would affect Sheet2. I need the VBA to loop through Sheets("Sheet2").Range("A:A") and (1) lookup the name in Sheet1; (2a) count the unique order numbers that correspond with the salesperson's name and are "Open" and (2b) count the unique order numbers that correspond with the salesperson's name and are "Closed". I have designed "?"s for the values I am looking to calculate with the macro and included the answer numbers.

Any help is greatly appreciated. Please let me know if I can clarify anything.

Sheet1 - Orders

enter image description here

Sheet2 - Orders Summary

       A                   B                            C    
1  **Name**   **Count-Uniq Open Orders**   **Count-Uniq Closed Orders**
2   John              ? (answer: 2)                ? (answer: 0)
3   Ben               ? (answer: 1)                ? (answer: 1)
4   Fred              ? (answer: 1)                ? (answer: 0)

Sorry, missed the Unique part of the question; one moment... — Simon1979, Mar 11 '14 at 03:47
I'm with Doug - Pivot tables are made for this sort of thing — whytheq, Mar 11 '14 at 08:39

score 2 · Answer 1 · answered Mar 11 '14 at 05:14

Tested:

Sub Tester()

Dim d1, d2, arrIn, r, tmp, nm, id, i
Dim c, k

    Set d1 = CreateObject("scripting.dictionary")
    Set d2 = CreateObject("scripting.dictionary")

    With Sheets("orders")
        arrIn = .Range(.Range("A2"), _
                       Cells(Rows.Count, 3).End(xlUp)).Value
    End With

    For r = 1 To UBound(arrIn, 1)
        nm = arrIn(r, 1) 'name
        id = arrIn(r, 2) 'order #
        If Not d1.exists(nm) Then
            d1.Add nm, Array(0, 0)
        End If
        If Not d2.exists(id) Then
            tmp = d1(nm)
            i = IIf(UCase(arrIn(r, 3)) = "OPEN", 0, 1)
            tmp(i) = tmp(i) + 1
            d1(nm) = tmp
            d2.Add id, 0
        End If
    Next r

    Set c = Sheets("summary").Range("a2")
    For Each k In d1.keys
        c.Resize(1, 3).Value = Array(k, d1(k)(0), d1(k)(1))
        Set c = c.Offset(1, 0)
    Next k
End Sub

Simon1979 · Answer 2 · 2014-03-11T04:08:47.730

1

In cell B2 of sheet 2:

=SUM(IF(FREQUENCY(IF(Sheet1!$A$2:$A$10=$A2,IF(Sheet1!$C$2:$C$10=B$1,Sheet1!$B$2:$B$10)),IF(Sheet1!$A$2:$A$10=$A2,IF(Sheet1!$C$2:$C$10=B$1,Sheet1!$B$2:$B$10)))>0,1))

This is an array formula so to confirmit hold Ctrl + Shift and hit Enter, this will add a { and } at start and end respectively.

In cell C3:

=SUM(IF(FREQUENCY(IF(Sheet1!$A$2:$A$10=$A2,IF(Sheet1!$C$2:$C$10=C$1,Sheet1!$B$2:$B$10)),IF(Sheet1!$A$2:$A$10=$A2,IF(Sheet1!$C$2:$C$10=C$1,Sheet1!$B$2:$B$10)))>0,1))

Same again, it's an array so Ctrl+Shift and Enter

And then copy the formulae down.

edited Mar 11 '14 at 04:08

answered Mar 11 '14 at 03:46

Simon1979

2,110
1
12
15

1

Thanks for the formulas @Simon1979. I was really looking for VBA, but this will also be quite helpful. – blahblahblah Mar 12 '14 at 01:33

score 1 · Accepted Answer · answered Mar 11 '14 at 06:17

Try this one :)

Sub Macro1()

    Dim ws1 As Worksheet, ws2 As Worksheet, wsTemp As Worksheet
    Dim rng As Range
    Dim myformula1 As String, myformula2 As String

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

    Set ws1 = ThisWorkbook.Sheets("Sheet1") 'where you have your Orders
    Set ws2 = ThisWorkbook.Sheets("Sheet2") 'where you have your summary which should have names in it
    ws1.Copy ThisWorkbook.Sheets(1)
    Set wsTemp = ActiveSheet: wsTemp.Name = "Temp"

    With wsTemp
        Set rng = .UsedRange
        rng.RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
    End With

    myformula1 = "=COUNTIFS(" & wsTemp.Name & "!A:A,A2," & wsTemp.Name & "!C:C,""Open"")"
    myformula2 = "=COUNTIFS(" & wsTemp.Name & "!A:A,A2," & wsTemp.Name & "!C:C,""Closed"")"

    With ws2.Range(ws2.Range("A2"), ws2.Range("A" & ws2.Rows.Count).End(xlUp))
        .Offset(0, 1).Formula = myformula1
        .Offset(0, 2).Formula = myformula2
        .Offset(0, 1).Resize(, 2).Value = .Offset(0, 1).Resize(, 2).Value
    End With

    wsTemp.Delete
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With

End Sub

No loop. Just to give you an alternative :D
Hope this helps in any way.

Thanks @L42m, I liked the idea of creating a temporary table. Worked great. — blahblahblah, Mar 12 '14 at 01:33

score 0 · Answer 4 · edited May 23 '17 at 12:09

0

Just as an alternative, in terms of a pivot table solution the following answer covers the techniques required:

Simple Pivot Table to Count Unique Values

edited May 23 '17 at 12:09

Community

1
1

answered Mar 11 '14 at 08:55

whytheq

34,466
65
172
267

VBA Count of unique values with a second criteria

4 Answers4