Filtering based on a value from a different column but also from a different row

user_19567201 0
Viewed 55

I'm quite new to VBA, so I'm guessing this is way above my head at the moment, but I've been having this procedure in mind for quite some time and the fact that I can't figure out anything that even remotely resembles a solution is killing me. So here's my problem - I would like to filter values from "Column 1" if the corresponding value in "Column 2" is "B", but only if none of the identical (duplicate) values in Column 1 have a value of "A" in "Column 2".

To simplify - the output should be "2" and "4", since those are the only values that don't have a value of "A" in "Column 2" in any of their iterations in "Column 1".

I was able to do this in Excel using two dynamic formulas and XLOOKUP, but there must be something more elegant that can be done via VBA. Right now I can only do For Each Loop that would filter all the values that have a value of "B" in Column 2 (in this case it would return all the values from "Column 1" except "3"), which isn't what I need at all.

Sub ChooseStatus()

Dim Sheet1 As Worksheet
Set Sheet1 = ThisWorkbook.Sheets("Sheet1")
    
'defining the area
lr = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row

sr = Selection.Row

'defining categories

Item = Sheet1.Cells(sr, 1)
Status = Sheet1.Cells(sr, 2)

'loop

For i = 2 To lr
    If Sheet1.Cells(i, 2) = "B" Then
    Sheet1.Cells(i, 1).Interior.Color = rgbBlue
    End If
    
Next i
   
End Sub

Any assistance you could provide is much appreciated.

Item Status
1 A
1 B
1 B
2 B
2 B
3 A
3 A
4 B
5 A
5 B
filtering duplicates unique vba excel
1 Answers

If you dispose of Excel version MS365 and its UNIQUE() function, you might try the following procedure Examplecall together with the user defined help functions GetFormula() and IsValid(). (If not there are many examples at SO how to get unique values in versions before).

This approach demonstrates also the use of the following frequent VBA functions

Example call

Option Explicit                 ' force declarations at code module head

Sub ExampleCall()

With Sheet1                     ' << change to wanted sheet Code(Name)
    Dim rng As Range
    Set rng = .Range("A2:B11")  ' << change to wanted range (note the starting "."-point)
'a) get uniques array & provide for temporary results array
    Dim uniques
    uniques = .Evaluate(GetFormula(rng))
    Dim results
    results = uniques           ' contains temporarily all uniques
End With
'b) mark all invalid items for deletion
    Dim i As Long
    For i = 1 To UBound(uniques)
        If Not IsValid(uniques, i) Then results(i) = "$DEL$"
    Next i
'c) remove marked items from results array
    results = Filter(results, "$DEL$", False)       ' negative filtering removes $DEL$ items
    MsgBox Join(results, vbNewLine), vbInformation, "Found elements"
End Sub

Help functions

Function GetFormula(rng As Range, Optional Delim As String = "-") As String
'a) define column number within the passed range argument
    Const ITEM As Long = 1, STATUS As Long = 2          '
    If rng.Columns.Count < Application.Max(ITEM, STATUS) Then Exit Function  ' provide for sufficient columns
'b) define formula pattern
    Dim Pattern As String
    Pattern = "transpose(Unique(X & """ & Delim & """ & Y))"            ' get unique combined strings
'c) replace range references X and Y with address string
    GetFormula = Replace(Replace(Pattern, _
        "X", rng.Columns(ITEM).Address(0, 0)), _
        "Y", rng.Columns(STATUS).Address(0, 0))
End Function

Function IsValid(uniques, no As Long, _
            Optional Exclude As String = "A", _
            Optional Delim As String = "-") As Boolean
'a) get prefix of element no (i.e. string part before hyphen)
    Dim ItemPrefix As String
    ItemPrefix = Split(uniques(no), "-")(0)             ' isolate string part before "-" via Split()
'b) filter items to be excluded
    Dim tmp
    tmp = Filter(uniques, ItemPrefix & Delim & Exclude, True)   ' positive filtering of term to be excluded
'c) if there are no found items then return True as function result
    If UBound(tmp) = -1 Then                            ' upper boundary -1 indicates empty 0-based array
        IsValid = True                                  ' return positive function result
    End If
End Function
user_64602970
Related