UDF CountUniqueIF

[WarriorJyn]

Hi ALL!!

I've been working on a VBA project on and off for a little while to make things easier at work. to tell you a bit about my work, I'm actually a lab analyst rather than a data analyst, so mostly I'm mucking in testing tap water rather than playing around with excel ; but each day we receive an excel file showing the samples we are going to receive and what their tests are in case they don't scan on arrival. People were manually searching through each day to find out the total number of samples expected and total microbiology tests to find out how much media to use. So I spent an afternoon writing a macro for them to be able to do it in seconds, which as there are 7000 rows they are pretty happy about! however what illuded me for some time was a way of searching through the sample numbers to work out how many bottles were going to arrive. I could have just copied the way they were doing it with a macro but somehow it felt like cheating. I wanted to use a formula, but I couldn't find anything that did the job. I did find a UDF which could count unique results, but I couldn't use it reliably as it was also counting samples which didn't have a sampled date. So I sat and played with it, adding things and so on and now it works Please suggest any changes if you can think of a way to work more clearer or more effectively. Mostly I'm sharing this because I couldn't find it anywhere online, and yet I'm sure it has utilisation elsewhere, so I would like to make it freely available.

Here is an example of the data we receive to relevant to the function, sometimes there is no bottle number, sometimes there is no sampled date, on both of these occasions the sample should not be counted.
The function will only count a sample if the first column of the range matches the search criteria, e.g. sampled date.

SAMPLED_DATE	SAMPLED_TIME	AD_HOC	CONTAINER_TYPE	BOTTLE_NUMBER
07-FEB-19	12:52		BACT	SW4072901
07-FEB-19	12:52		BACT	SW4072901
07-FEB-19	12:52		BACT	SW4072901
07-FEB-19	12:52		BACT	SW4072902
07-FEB-19	12:52		BACT	SW4072902
07-FEB-19	12:52		BACT	SW4072902
07-FEB-19	12:52		STL101_PHYS	SW4072903
07-FEB-19	12:52		STL101_PHYS	SW4072903
07-FEB-19	12:52		STL101_PHYS	SW4072903
07-FEB-19	12:52		STL103	SW4072904
07-FEB-19	12:52		STL103	SW4072904
			STL25	SW4072905
			STL25	SW4072905
			STL25	SW4072905
07-FEB-19	12:52

<tbody>
</tbody>

 Function CountUniqueIF(rng As Range, criteria As String, result_distance) As Integer
   
  Dim ICV As Range 'Individual cell value
  Dim LKUP As Variant 'Vlookup code
  Dim cnt As New Collection 'final count
   
  Application.Volatile
   
  On Error Resume Next
   
  For Each ICV In rng.Rows
   

   

  LKUP = WorksheetFunction.VLookup(criteria, ICV, result_distance, 0)  'Compares ICV to criteria and if matched gives result as the cell to the  right of it by result_distance. e.g. 5 cells away

  If Not IsEmpty(LKUP) Then 'to ignore blank cells
      cnt.Add LKUP, CStr(LKUP) 'to add the unique item
  End If

  Next

   
  CountUniqueIF = cnt.Count
   
   
  End Function

=CountUniqueIF(A2:E16,'07-FEB-19',5)

Final result = 4 bottles sampled.

 

[FlexMind]

Hello.
A nice function, thank you for sharing!
My variant is some usable for me:

Function FlexCountUniqueIf(rng As Range, criteria As String, resultDistanceRng As Range) As Long 
  
Dim LKUP As Long, resultDistance As Long, rowsCount As Long, cnt As Object, sampledDate, bottleNumber
Set cnt = CreateObject("System.Collections.ArrayList")
If resultDistanceRng.Columns.Count > 1 Then FlexCountUniqueIf = CVErr(xlErrValue): Exit Function
resultDistance = resultDistanceRng.Column
rowsCount = Cells(Rows.Count, Range(rng.Address).Column).End(xlUp).Row
sampledDate = Range(Cells(1, rng.Column), Cells(rowsCount, rng.Column)).Value
bottleNumber = Range(Cells(1, resultDistance), Cells(rowsCount, resultDistance)).Value
For LKUP = 1 To rowsCount
If sampledDate(LKUP, 1) = criteria And Not IsEmpty(bottleNumber(LKUP, 1)) Then
If Not cnt.Contains(bottleNumber(LKUP, 1)) Then cnt.Add (bottleNumber(LKUP, 1))
End If
Next
FlexCountUniqueIf = cnt.Count

End Function

=FlexCountUniqueIf(A:E,[COLOR=#574123]'[/COLOR]07-FEB-19[COLOR=#574123]'[/COLOR],E:E)