count unique Values in column B based on criteria in column A

Question

I want to count unique values in column B based on criteria in column A, that is the problem:

• in column A we have the months number:

   A : 1 1 1 2 2 2 2 2 2 3 3 3 3 3 3 * 

• in column B we have the serial number of the cars:

   B : H185 H185 S556 S556 s521 s521 f221 s521 d558 r5569 d558 d558 r555 r555 * 

I want to know how many cars were produced in each month, and get a response:

msgbox ( month 1 , 'NB produced car" , month 2," NB produced cars , ......) . 

Answer 1

Query-wise you have to do the following:

select count(B), A
 from tablename
group by A;

This gets you the list... then use it in your application.

Answer 2

The following approach uses Dictionary objects to keep a tally of months and unique cars produced. You may have to amend the code to correct for ranges and messages. Let us know if this works for you / if you need more help.

Sub CountUniqueByMonth()
    Dim rData As Range
    Dim oDictOuter As Object
    Dim rIterator As Range

    Set rData = Range("A2:A" & Range("A2").End(xlDown).Row)

    Set oDictOuter = CreateObject("Scripting.Dictionary")

    For Each rIterator In rData
        AddToDictIfNotExists oDictOuter, rIterator.Value, CreateObject("Scripting.Dictionary")
        AddToDictIfNotExists oDictOuter(rIterator.Value), rIterator.Offset(, 1).Value, ""
    Next rIterator


    For Each Key In oDictOuter.Keys
        MsgBox "Month: " & Key & " - " & oDictOuter(Key).Count & " produced car(s)"
    Next Key
End Sub

Private Sub AddToDictIfNotExists(oDict As Object, vKey As Variant, vValue As Variant)
    If Not oDict.exists(vKey) Then
        oDict.Add vKey, vValue
    End If
End Sub

Answer 3

you can try this

Option Explicit

Sub main()
    Dim cell As Range
    Dim msg As String

    With Worksheets("Month-Cars").Range("A1:A" & Range("A2").End(xlDown).Row).SpecialCells(xlCellTypeConstants, xlNumbers) 'process only given sheet (change the name as per your needs) column "A" cells with numbers
        .Offset(, 2).FormulaR1C1 = "=COUNTIFS(RC1:R" & .Rows(.Rows.Count).Row & "C1,RC1,RC2:R" & .Rows(.Rows.Count).Row & "C2, RC2)" 'use "helper" cells in column "C" to localize unique pairs "month-serial number"
        With .Offset(, 3) 'use "helper" cells in column "D" to associate each month its unique pairs sum
            .FormulaR1C1 = "=COUNTIFS(" & .Offset(, -3).Address(, , xlR1C1) & ",RC1," & .Offset(, -1).Address(, , xlR1C1) & ",1)" 'calculate unique pairs sum
            .Value2 = .Value2 'get rid of formulas
        End With
        .Copy Destination:=.Offset(, 4) 'use "helper" cells in column "E" to duplicate "month" values and subsequent removing duplicates purposes
        .Offset(, 3).Resize(, 2).RemoveDuplicates Columns:=Array(2), Header:=xlNo ' remove months duplicate values

        For Each cell In .Offset(, 4).SpecialCells(xlCellTypeConstants, xlNumbers) 'loop through unique months to build the report message
            msg = msg & "month " & cell.Value2 & ": " & cell.Offset(, -1) & " produced car" & IIf(cell.Offset(, -1) > 1, "s", "") & vbCrLf
        Next cell

        .Offset(, 2).Resize(, 3).ClearContents 'clear all "helper" cells in columns "C", "D" ed "E"
    End With

    MsgBox msg 'prompt the report message

End Sub

it's commented so that you can follow the code and make possible changes