VBA counter ignore duplicates-CodePudding

I am struggling with changing counter in my macro. I just started my VBA adventure and spend whole day checking forums and tried many codes, but nothing is working.

I have a code which checks lots of conditions in table. In column F I have listed unique values. In column AE I have the same values, but some of them are duplicated, like in 2 or 3 lines. Now my code checks if value from column F exists in column AE and then checks other conditions like if there is "OB" in column AH and some more conditions. Then it counts how many values it found, but it counts duplicates as well. I need to change it to count only unique values from column AH. So lets say if value X is duplicated in AE2 and AE4 and both of them have "OB" in column AH, then counter shows only 1. Can somebody please explain me how to do it?

So if you look at the example, I have a list of unique values in column F. Column AE contain the same values, but in duplicated lines. 1st part of macro, for example, checks if value in column AE has "OB" in column AH and shows counter in J2. But now it shows 7, because it found 7 lines with values with "OB" in AH, but I need it to show 3, because the values are duplicated. Later macro checks if value has "OB" in column AH and if is different than 0 in column AM. Then it shows 2nd counter in K2. Right now it shows 3, because it found 3 lines with two conditions, but I need it to show 1, because it is the same value.

My code:


   Dim lr1 As Long
       lr1 = Cells(Rows.count, "F").End(xlUp).Row
   Dim lr2 As Long
       lr2 = Cells(Rows.count, "AE").End(xlUp).Row
   Dim count As Long
   Dim counter As Long   
   Dim x As Long
   Dim y As Long


'••••••••••••••••• CHECK IF MATERIAL IS USED IN ACTIVE BOM •••••••••••••••••


'Loop in both ranges
   For x = 3 To lr1
       For y = 3 To lr2
           If range("F" & x) = range("AE" & y) Then
'If material is set to OB
               If UCase(range("AH" & y)) = "OB" Then
                   'And is used in BoM
                   If range("AO" & y) <> "" Then
                       'And BoM is not OB
                       If UCase(range("AP" & y)) <> "OB" Then
                           'Add to counter
                           count = count   1
             '  range("F" & x).Interior.ColorIndex = 3
                        End If
                   End If
               End If
           End If
       Next y
   Next x
   
'Display results in J2
   If count > 0 Then
       range("J2") = count & " found"
       range("J2").Font.Color = vbRed
       
   Else
       range("J2") = "None"
       range("J2").Font.ColorIndex = 10
   End If
   
   
   
'••••••••••••••••• CHECK IF MATERIAL IS ON STOCK •••••••••••••••••

'Loop in both ranges
   For x = 3 To lr1
       For y = 3 To lr2
           If range("F" & x) = range("AE" & y) Then
'If material is set to OB
           If UCase(range("AH" & y)) = "OB" Then
'And is on stock
           If range("AM" & y) <> "0" Then
'Add to counter
               counter = counter   1
           End If
           End If
           End If
       Next y
   Next x
   
   
'Display results in K2
   If counter > 0 Then
       range("K2") = counter & " on stock"
       range("K2").Font.Color = vbRed
       
   Else
       range("K2") = "None"
       range("K2").Font.ColorIndex = 10
   End If

CodePudding user response：

Here your are. The code first checks if the value in column AE is existing in the list of unique values and if column AH = "OB".

If this unique value has not been added to the unique collection, it will be added and the Unique count is increased, else it is ignored.

Function Condition1()
Dim ws As Worksheet: Set ws = Worksheets("Sheet1")
Dim uniqueRange As Range: Set uniqueRange = ws.Range("F2:F9")
Dim checkList As Collection

Dim i As Integer
Dim UniqueCounter As Integer

Set checkList = New Collection
For i = 2 To 15
    Dim findStr As String
    findStr = ws.Cells(i, "AE")
    If Not uniqueRange.Find(findStr, LookIn:=xlValues) Is Nothing And ws.Cells(i, "AH") = "OB" Then  'Check if Value exists in master, if not ignore
        Dim keyExists As Variant
        On Error Resume Next
        keyExists = Empty
        keyExists = checkList(findStr)
        On Error GoTo 0
        If IsEmpty(keyExists) Then
            UniqueCounter = UniqueCounter   1
            checkList.Add findStr, findStr
        End If
    End If
Next
Condition1 = UniqueCounter
End Function