I need to find the number of occurrences in a column where criteria in three other columns (same row) are met. There are also a lot of duplicates I need to exclude. This is why I am using a dictionary. All of the passed ranges (columns) are the same length, vary up 30,000 rows, and exclude the header. The Filters I am passing are the criteria and are supplied when calling the function. There are two sheets – sheet and pSheet. I am expecting a result from the function, but it constantly returns nothing. There should be multiple items in the dictionary.
Hopefully, I have supplied enough information so someone can point out my mistake. Thanks in advance!
Setting the ranges:
Set columnH = Worksheets(sheet).Range("H2:H" & lastRow) 'Department Column
Set columnI = Worksheets(sheet).Range("I2:I" & lastRow) 'Item # Column
Set columnK = Worksheets(sheet).Range("K2:K" & lastRow) 'CS or PK Column
Set columnU = Worksheets(sheet).Range("U2:U" & lastRow) 'UPC Exists Column
Calling the function:
Sheets(pSheet).Range("T4") = ListLength(columnI, columnK, columnH, columnU, "PK-1", "DRY", "Yes") 'Searches for Items that are PK, in DRY department, and have a UPC
The function:
Function ListLength(Range1, Range2, Range3, Range4, Filter1, Filter2, Filter3) As Long
Dim i As Long
Dim itemList As Scripting.Dictionary
Set itemList = New Scripting.Dictionary
i = 0
For Each Item In Range1
If Range2(i) = Filter1 Then
If Range3(i) = Filter2 Then
If Range4(i) = Filter3 Then
If Not itemList.Exists(Item) Then
itemList.Add Item.Value, 0
End If
End If
End If
End If
i = i + 1
Next Item
ListLength = itemList.Count
End Function
5
I found the problem…obvious and blatant oversight!
I forgot to declare Item as Range!
I got your code working following the changes outlined in my comments, but this slightly different approach is more flexible and easier to call I think:
Option Explicit
Sub tester()
Dim ws As Worksheet, lastRow As Long
lastRow = 13 'for example
Set ws = ThisWorkbook.Worksheets("Data")
Debug.Print CountUniques(ws.Range("I2:I" & lastRow), "K", "PK-1", "H", "DRY", "U", "Yes")
End Sub
' `ValuesRange` contains the values for which you want the unique count
' `Filters` is an alternating list of column indexes (numeric or letter) and values to test for
Function CountUniques(ValuesRange As Range, ParamArray Filters()) As Long
Dim c As Range, v, itemList As Scripting.Dictionary, rw As Range, i As Long
Set itemList = New Scripting.Dictionary
For Each c In ValuesRange.Cells
v = c.Value
If Len(v) > 0 Then
Set rw = c.EntireRow
For i = 0 To UBound(Filters) Step 2 'loop over Filters (if any provided)
If rw.Columns(Filters(i)) <> Filters(i + 1) Then GoTo skip
Next i
If Not itemList.Exists(v) Then itemList.Add v, 0
End If 'value to check
skip:
Next c
CountUniques = itemList.count
End Function
you could use AutoFilter() method and then loop through filtered cells only
Function ListLength(dataRange As Range, filter1 As String, filter2 As String, filter3 As String) As Long
With dataRange
.AutoFilter 4, "PK-1"
.AutoFilter 1, "DRY"
.AutoFilter 14, "Yes"
Dim d As Scripting.Dictionary
Set d = New Scripting.Dictionary
Dim c As Range
For Each c In .Columns(2).Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible)
d(c.Value2) = 1
Next
.Parent.AutoFilterMode = False
End With
ListLength = d.Count
End Function
as you can see you can pass the entire range instead of splitting it into those 4 sub ranges
and the calling could be like:
Sub main()
With Worksheets(sheet)
With .Range("H1:U" & .Cells(.Rows.Count, "H").End(xlUp).Row)
Worksheets(pSheet).Range("T4").Value = ListLength(.Cells, "PK-1", "DRY", "Yes")
End With
End With
End Sub
Or you can also use the RemoveDuplicates() method and avoid the Dictionary object
Function ListLength2(dataRange As Range, filter1 As String, filter2 As String, filter3 As String) As Long
With dataRange
Dim vals As Variant
vals = .Value 'save the range values since some of them will be possibily deleted after RemoveDuplicate() method
.AutoFilter 4, "PK-1"
.AutoFilter 1, "DRY"
.AutoFilter 14, "Yes"
.RemoveDuplicates Array(2), xlYes
ListLength2 = WorksheetFunction.CountA(.Columns(2)) - 1 ' count remaining values in column 2 of the range, header excluded
.Parent.AutoFilterMode = False
.Value = vals ' put range original values back
End With
End Function