Count distinct values that correspond to a criteria

Hi,

I have a list of Customer and Items they have ordered.

I have this code that counts how many orders have been placed for 2 specific items (TBA and 8IM) and places the value in worksheet List cell A1:

Sub CountItems()
Dim wsd As Worksheet, wsc As Worksheet
Dim Lastrow As Long, i As Long, J As Long
Dim Cell As Range

Set wsc = Sheets("List")
Set wsd = Sheets("Jan")

i = 0

Application.ScreenUpdating = False

With wsd
    Lastrow = .Range("B" & Rows.Count).End(xlUp).Row
    For Each Cell In .Range("B2:B" & Lastrow)
        If Cell = "TBA" Or Cell = "8IM" Then
i = i + 1
        End If
    Next Cell
End With
 
With wsc
    .Range("A1").Value = i

End With

Application.ScreenUpdating = True

End Sub

I would need some suggestions how to amend this code to count how many Customers have ordered either item TBA or item 8IM. If a Customer ordered at least once any of these items it has to be counted as 1.

Thanks,
Eduard

You do not need a code for this. Pivot table is much more flexible

Anyone there who can help, please? Let me know if I have to clarify something. Thanks.

Hello!

Why not =CountIfI(B2:B9376;"TBA")+CounttIf(B2:B9376;"8IM")

JB

Sub CountItems()
Dim wsd As Worksheet, wsc As Worksheet
Dim Lastrow As Long, i As Long, J As Long
Dim Cell As Range

Set wsc = Sheets("List")
Set wsd = Sheets("Jan")

i = 0

Application.ScreenUpdating = False

With wsd
Lastrow = .Range("B" & Rows.Count).End(xlUp).Row
For Each Cell In .Range("B2:B" & Lastrow)
If Cell = "TBA" Then
i = i + 1
ElseIf Cell = "8IM" Then
J = J + 1
End If
Next Cell
End With

With wsc
.Range("A1").Value = "TBA"
.Range("A2").Value = "8IM"
.Range("B1").Value = i
.Range("B2").Value = J

End With

Application.ScreenUpdating = True

End Sub

Thanks sujitshukla, but this will not work. This code will just return the number of orders for each item TBA and 8IM. It does not calculate how many customers ordered these item. You may have 1 customer ordering more than once the same item. That has to count as 1 and not for each time he placed the order.

Hi edward

I think that the easiest way to do this is to use a select function to select all cells with TBA and 8IM, this may have to be done separately.

Then add the customername to a collection such that duplicates are eliminated.

15 lines of code should do it.

Bear with me............

Thanks boisgontier. I have tried using array formulas, but that works very slow. I have 11 other worksheets and it takes minutes to calculate all the values.

Ok this is One Method.

Read all the values into an array and check each row.

I will re-write this to use excel sort to reduce the length of the loop.

Originally Posted by MarvinP

If a built-in function or formula is available, why not use it as they are ALWAYS faster than VBA or Array formulas.

Not always.

try

Sub CountItems()
    Dim a, i As Long, n As Long
    a = Sheets("jan").Cells(1).CurrentRegion.Value
    With CreateObject("Scripting.Dictionary")
        a(1, 2) = "Count": n = 1
        For i = 2 To UBound(a, 1)
            If (a(i, 2) = "TBA") + (a(i, 2) = "8IM") Then
                If Not .exists(a(i, 1)) Then
                    n = n + 1: .Item(a(i, 1)) = n
                    a(n, 1) = a(i, 1): a(n, 2) = 1
                Else
                    a(.Item(a(i, 1)), 2) = a(.Item(a(i, 1)), 2) + 1
                End If
            End If
        Next
    End With
    Sheets("list").Cells(1).Resize(n, 2).Value = a
End Sub

Hi MarvinP,

I would need to have 12 pivot tables since I have 12 worksheets with data, i.e. one for each month. Every time a new worksheet is added the user will have to create the pivot table and they don't necessarily know how to do that. Clicking a button with a macro would be more practical and user-friendly.

Eduard

This is a faster method than my previous post

With UDF

Function ItemsDifferentsCritere(champ, champcritere, critere)
  Set MonDico = CreateObject("Scripting.Dictionary")
  a = champ
  b = champcritere
  For i = 1 To champ.Count
    If b(i, 1) = critere And a(i, 1) <> "" Then
       temp = a(i, 1)
       MonDico(temp) = temp
    End If
  Next i
  ItemsDifferentsCritere = MonDico.Count
End Function

JB

@JapanDave
Should this

If a(j, 2) = "TBA" Or Cell = "8IM" Then

be?

If a(j, 2) = "TBA" Or a(j, 2) = "8IM" Then

Hi MarvinP,

Your macro does not seem to work. Gives an error in this line:

    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        ActiveSheet.Name & "!R1C1:R" & LastRow & "C2", Version:=xlPivotTableVersion15).CreatePivotTable _
        TableDestination:=ActiveSheet.Name & "!R3C4", TableName:="PivotTable3", DefaultVersion:= _
        xlPivotTableVersion15

Thanks JapanDave. This is exactly what I was looking for.