Count Unique based on two criteria VBA

[-=NO=-]

Hello Dears

Please if anyone can support in that;

I need to convert the below formula to VBA code,

{=SUM(IF(("City"=Receiving[BRANCH])*('Build Dashboard'!I12=Receiving[CATEGORY LEVEL]), 1/COUNTIFS(Receiving[BRANCH],"City",Receiving[RECEIPT NUMBER],Receiving[RECEIPT NUMBER],Receiving[CATEGORY LEVEL],'Build Dashboard'!I12)), 0)}

The issue that I need a code to make a count for unique values depending on two different criteria, the count will be added in a table according to the input criteria

As per table below; the two criteria are (City & Category) and the unique count range is (Receipt no.).

City	Category	Receipt no.
X	XX	222110130683
X	XX	222110130683
Y	YX	2310124850
Y	XX	2110123413
X	XX	2110123415
Y	YX	2110123419

Then, the data developed will be copied in the below table

City	Category	Count
X	XX	??
Y	YX	??

 

[alansidman]

If I am understanding your request then with Power Query

let
    Source = Excel.CurrentWorkbook(){[Name="Table3"]}[Content],
    #"Grouped Rows" = Table.Group(Source, {"City", "Category"}, {{"Count", each Table.RowCount(_), Int64.Type}})
in
    #"Grouped Rows"

Book2
	A	B	C
2	X	XX	3
3	Y	YX	2
4	Y	XX	1
Table3

 

[-=NO=-]

If I am understanding your request then with Power Query

let
    Source = Excel.CurrentWorkbook(){[Name="Table3"]}[Content],
    #"Grouped Rows" = Table.Group(Source, {"City", "Category"}, {{"Count", each Table.RowCount(_), Int64.Type}})
in
    #"Grouped Rows"

Book2
	A	B	C
2	X	XX	3
3	Y	YX	2
4	Y	XX	1
Table3

No sir; the first row should be counted as 2 (as there's one receipt of 3 is duplicated)

 

[mohadin]

If this expected results

City	Category	Count
X	XX	2
Y	YX	1
Y	XX	1
X	XX	1
Y	YX	1

Then try

Sub test()
    Dim a As Variant, i, ii, x
    a = Range("a1:a" & Cells(Rows.Count, 1).End(xlUp).Row).Resize(, 3)
    With CreateObject("scripting.dictionary")
        For i = 2 To UBound(a)
            If a(i, 1) <> "" Then
                If Not .exists(a(i, 3)) Then
                    .Add (a(i, 3)), Array(a(i, 1), a(i, 2), 1)
                Else
                    x = .Item(a(i, 3))
                    x(0) = x(0): x(1) = x(1): x(2) = x(2) + 1
                    .Item(a(i, 3)) = x
                End If
            End If
        Next
        Cells(1, 5) = Cells(1, 1): Cells(1, 6) = Cells(1, 2): Cells(1, 7) = "Count"
        Cells(2, 5).Resize(.Count, 3) = Application.Transpose(Application.Transpose(.Items))
    End With
End Sub

 

[-=NO=-]

If this expected results

City	Category	Count
X	XX	2
Y	YX	1
Y	XX	1
X	XX	1
Y	YX	1

Then try

Sub test()
    Dim a As Variant, i, ii, x
    a = Range("a1:a" & Cells(Rows.Count, 1).End(xlUp).Row).Resize(, 3)
    With CreateObject("scripting.dictionary")
        For i = 2 To UBound(a)
            If a(i, 1) <> "" Then
                If Not .exists(a(i, 3)) Then
                    .Add (a(i, 3)), Array(a(i, 1), a(i, 2), 1)
                Else
                    x = .Item(a(i, 3))
                    x(0) = x(0): x(1) = x(1): x(2) = x(2) + 1
                    .Item(a(i, 3)) = x
                End If
            End If
        Next
        Cells(1, 5) = Cells(1, 1): Cells(1, 6) = Cells(1, 2): Cells(1, 7) = "Count"
        Cells(2, 5).Resize(.Count, 3) = Application.Transpose(Application.Transpose(.Items))
    End With
End Sub

Thanks Sir; I do appreciate that, but

I just make a simple example, If I have many columns in source sheet (not only these 3 columns), how can I edit in your code to fit my table.

 

[mohadin]

OK

 a = Range("a1:a" & Cells(Rows.Count, 1).End(xlUp).Row).Resize(, 3)

3 change it as per you columns NO
Then
if City & Category will go to a(i,1) & a(i,2)
a(i,3) for Receipt no.

so follow then in the new array (a)
Hope this can helps

 

[-=NO=-]

OK

 a = Range("a1:a" & Cells(Rows.Count, 1).End(xlUp).Row).Resize(, 3)

3 change it as per you columns NO
Then
if City & Category will go to a(i,1) & a(i,2)
a(i,3) for Receipt no.

so follow then in the new array (a)
Hope this can helps

Thanks Again
And what about these

Cells(1, 5) = Cells(1, 1): Cells(1, 6) = Cells(1, 2): Cells(1, 7) = "Count"
Cells(2, 5).Resize(.Count, 3) = Application.Transpose(Application.Transpose(.Items))

 

[mohadin]

Cells(1, 5) = Cells(1, 1): Cells(1, 6) = Cells(1, 2): Cells(1, 7) = "Count"
Cells(2, 5).Resize(.Count, 3) = Application.Transpose(Application.Transpose(.Items))

Depends on the expected result

 

[-=NO=-]

Depends on the expected result

What I understood that the first line for header names in the target sheet
but the second line retrieve 0, I have the actual count column in my sheet in starting from cell L12 to L15

Can you please adjust the last line when copying data to include only count figures not category or city

 

[mohadin]

Replace with

  Cells(12, 12).Resize(.Count) = Application.Index(Application.Transpose(Application.Transpose(.Items)), 0, 3)