Count unique values based on criteria given in another column

Question

I have a list of machines with respective batches and part number being manufactured.
I need a unique count of a batches running in a machine. This long list is updated daily. I have attached an example here.

I have this rough code.

last_row = ws.Cells(Rows.Count,1).End(xlUp).Row
For Each M_cCell in M_cRange
    Counter = 0
    For i = 2 to last_row
        If Cells(1, 1).Value = M_cCell Then
            Counter = Counter + (1/(WorksheetFunction.CountIF _
            (Range(Cells(2,2),Cells(Last_row,2),M_ccell.Value)))
        End If
    Next i
Next M_cCell

This gives an undesired result in decimal figures.

Answer 1

Assumptions: a. data in columns A:C b. the only used ranges in data sheet are columns A:C c. results will be printed in range("E1")

the use of dictionaries would likely be one of the most efficient ways for you to remove duplicates given that you are expecting large quantities of data. Do let me know if this helps.

Sub test()
    Dim dictMachine As Object: Set dictMachine = CreateObject("scripting.dictionary")
    Dim dictBatch As Object
    Dim vTemp As Variant: vTemp = ActiveSheet.UsedRange
    Dim vTemp2 As Variant
    Dim i As Long


    For i = LBound(vTemp, 1) + 1 To UBound(vTemp, 1)
        Set dictBatch = CreateObject("scripting.dictionary")
        If dictMachine.exists(vTemp(i, 1)) Then
            dictMachine(vTemp(i, 1))(vTemp(i, 2)) = dictMachine(vTemp(i, 1))(vTemp(i, 2)) + 1
        Else
            dictBatch(vTemp(i, 2)) = dictBatch(vTemp(i, 2)) + 1
            Set dictMachine(vTemp(i, 1)) = dictBatch
        End If
    Next i

    vTemp = dictMachine.Keys
    ReDim vTemp2(0 To UBound(vTemp, 1) + 1, 0 To 1)
    vTemp2(0, 0) = "Machine"
    vTemp2(0, 1) = "Number of Batches"
    For i = LBound(vTemp, 1) To UBound(vTemp, 1)
        vTemp2(i + 1, 0) = vTemp(i)
        vTemp2(i + 1, 1) = dictMachine(vTemp(i)).Count
    Next i

    ActiveSheet.Range("E1").Resize(UBound(vTemp2, 1) - LBound(vTemp2, 1) + 1, UBound(vTemp2, 2) - LBound(vTemp2, 2) + 1) = vTemp2


End Sub

Answer 2

Not the very cleanest either, but you can avoid loops altogether and just use COUNTIF after using AdvancedFilter - When dealing with a big load of data this is quite efficient compared to loops.

Public Sub Test()
    Dim TargetSheet As Worksheet

    Set TargetSheet = Worksheets("Sheet2")

    With ActiveSheet
        .Range("A1:B20").AdvancedFilter xlFilterCopy, CopyToRange:=TargetSheet.Range("A1"), Unique:=True 'Get unique combinations
    End With

    With TargetSheet
        .Range("A1:A" & .Range("A1").End(xlDown).Row).AdvancedFilter xlFilterCopy, CopyToRange:=.Range("C1"), Unique:=True 'Get unique machines
        .Range("D2").Value = "=countif(A:A, C2)" 'Count batches per machine
        .Range("D2").AutoFill .Range("D2:D" & .Range("C2").End(xlDown).Row)


        .Range("D1").Value = "Count of batches:" 'Add count header 
        .Range("D:D").value = .Range("D:D").value 'replace formula's by values.    
        .Range("A:B").Delete shift:=xlToLeft 'Get rid of helper columns from first advanced filter.
    End With

    Set TargetSheet = Nothing
End Sub

Answer 3

Another solution:

Sub Demo()
    Dim rng As Range

    For Each rng In Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row)
        Cells(rng.Row(), "E").Value = Evaluate(Replace("IFERROR(INDEX($A$2:$A$15,MATCH(0,INDEX(COUNTIF($E$1:E#,$A$2:$A$15),0,0),0)),"""")", "#", rng.Row()))
        If Cells(rng.Row(), "E").Value = "" Then Exit For
        Cells(rng.Row, "F").FormulaArray = Evaluate(Replace("SUM(IF($A$2:$A$15=E#, 1/(COUNTIFS($A$2:$A$15, E#, $B$2:$B$15, $B$2:$B$15)), 0))", "#", rng.Row()))
    Next rng
End Sub

This displays the result in Column EF , see image for reference.

Answer 4

I would approach to this by easier way. Without any code example. Just think about this:

1. Loop through all data and find uniques according to both columns - in this case you will get just 2 results. Each new result you will save to temp array.

2. Loop again through all data and compare every row with every field of stored temp array. Add counters for that and that's all.

Answer 5

Efficiency of your code will largely depend on the number of times your code "hits" the worksheet - it will be much faster for you to read the data into an array before processing it. When it comes to unique counts, dictionary should come to mind. Assuming your data are in columns A to C, and output in column E...

Public Sub sub_UniqueCount()
    Dim wsThis As Worksheet: Set wsThis = ActiveSheet

    Dim vData As Variant
    Dim vOutput() As Variant
    Dim vKey

    Dim dicCount As Object: Set dicCount = CreateObject("scripting.dictionary")
    Dim dicTemp As Object

    Dim i As Long, j As Long

    Application.ScreenUpdating = False

    With wsThis
        ' load data into memory
        vData = .Range(.Range("A1").End(xlToRight), .Range("A1").End(xlDown))
        For i = LBound(vData, 1) + 1 To UBound(vData, 1)
            If dicCount.Exists(vData(i, 1)) Then
                dicCount(vData(i, 1))(vData(i, 2)) = dicCount(vData(i, 1))(vData(i, 2)) + 1
            Else
                Set dicTemp = CreateObject("scripting.dictionary")
                dicTemp(vData(i, 2)) = 1
                Set dicCount(vData(i, 1)) = dicTemp
            End If
        Next i

        ReDim vOutput(1 To dicCount.Count, 1 To 2)
        i = 1
        For Each vKey In dicCount.keys
            vOutput(i, 1) = vKey
            vOutput(i, 2) = dicCount(vKey).Count
            i = i + 1
        Next vKey

        .Range("E1").Resize(UBound(vOutput, 1) - LBound(vOutput, 1) + 1, UBound(vOutput, 2) - LBound(vOutput, 2) + 1) = vOutput

    End With

    Application.ScreenUpdating = True
End Sub