Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

I would like to filter rows wherein it's identical in 1 column and there must be no other combinations in 2 other columns

Tags:

excel

filter

vba

This is a link to my post in another place just in-case I get told that I am cross posting. ( https://www.mrexcel.com/board/threads/filtering-a-column-that-is-unique-in-2-columns-with-no-other-combinations.1273902/#post-6273193 )

I am very much a beginner in Excel VBA. So far, I have learned a lot, but I'm stuck in this one problem. I'm sorry I cannot post a sample spreadsheet due to privacy reasons (And it's all in Japanese). I want to be able to filter a row of data wherein it may or may not have multiple entries in Column G, but it must have identical data in Column C and column E.

This photo for example.

This means I can filter 'Ms.LLL' since there's only one existing combination. And if I try to filter 'Mr.MMM', it should give an error that "There are conflicting stores for this buyer."

I'm sorry for the trouble, but can anyone help me gain some light in this? I thank you all in advance.

I have been thinking of 'CountIfs' and 'Unique' for the 2 columns that I need as my criteria, so I have been doing trial and error on that for a while.

    Dim WORK_SHEET As Worksheet
    Dim UNIRANGE_ONE, UNIRANGE_TWO As Range
    Dim COUNT_RANGE As Range
    Dim UNIQUE_VALUES As Collection
    Dim CELL As Range
    Dim CRIT_ONE, CRIT_TWO As String
    Dim COUNT_RESULT As Long
    
    Set WORK_SHEET = ThisWorkbook.ActiveSheet
    Set UNIRANGE_ONE = WORK_SHEET.Range("C:C")
    Set UNIRANGE_TWO = WORK_SHEET.Range("E:E")
    
    Set COUNT_RANGE = WORK_SHEET.Range("G:G")
    
    Set UNIQUE_VALUES = New Collecton
    For Each CELL In UNIRANGE_ONE
        UNIQUE_VALUES.Add CELL.Value, CStr(CELL.Value)
    Next CELL
    On Error GoTo 0
    
    For Each CELL In UNIQUE_VALUES
        COUNT_RESULT = Application.WorksheetFunction.CountIfs(UNIRANGE_ONE,    UNIRANGE_TWO, CELL, COUNT_RANGE)
       Next CELL
    
    'For Each END_USER In ListRange
    'UniqueValues.Add CellValue, CStr(Cells(AROW, 7).Value)
    'Next
    'ENDUSER_COUNT = UniqueValues.Count
like image 389
Anpo Desu Avatar asked Dec 03 '25 21:12

Anpo Desu


2 Answers

Here's corrected code using dictionary to store information, more closely to what you have right now and maybe good for educational purposes:

Sub FilterBuyerWithMatchingStoreInfo()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim dict As Object
    Dim buyer As String
    Dim i As Long
    Dim uniquePair As String
    Dim pairsDict As Object
    Dim selectedBuyer As String
    Dim inputFound As Boolean
    
    Set ws = ThisWorkbook.ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row
    
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' Build dictionary: Buyer -> Collection of "ColC|ColE" values
    For i = 2 To lastRow ' Assuming headers in row 1
        buyer = Trim(ws.Cells(i, "G").Value)
        If buyer <> "" Then
            uniquePair = ws.Cells(i, "C").Value & "|" & ws.Cells(i, "E").Value
            If Not dict.exists(buyer) Then
                Set pairsDict = CreateObject("Scripting.Dictionary")
                dict.Add buyer, pairsDict
            End If
            dict(buyer)(uniquePair) = 1
        End If
    Next i
    
    ' Ask user which buyer to filter
    selectedBuyer = InputBox("Enter Buyer name to filter (from Column G):")
    If selectedBuyer = "" Then Exit Sub
    
    inputFound = dict.exists(selectedBuyer)
    
    If Not inputFound Then
        MsgBox "Buyer '" & selectedBuyer & "' not found.", vbExclamation
        Exit Sub
    End If
    
    ' Check how many unique C|E pairs the buyer has
    If dict(selectedBuyer).Count > 1 Then
        MsgBox "There are conflicting stores for this buyer.", vbCritical
        Exit Sub
    End If
    
    ' Clear previous filters
    If ws.AutoFilterMode Then ws.AutoFilter.ShowAllData
    
    ' Apply filter on Column G for the selected buyer
    ws.Range("A1").AutoFilter Field:=7, Criteria1:=selectedBuyer ' Column G is field 7
    
    MsgBox "Filter applied for '" & selectedBuyer & "'."
End Sub

Missing headers update

For missing headers, you could apply following strategy:

  1. Before applying autofilter, put some temp values in the headers row for auto filter to work

  2. Apply auto filter.

  3. Clear temporary header values, to restore original state.

In order to implement that, i could suggest

  1. declare new variables (in place where you have other declarations with Dim):

    Dim th As Variant
    Dim tempHeaders As Collection
    
  2. fill empty rows

    ' Temporarily fill missing headers and record positions
    For i = 1 To 7 ' Columns A to G
        If Trim(ws.Cells(1, i).Value) = "" Then
            ws.Cells(1, i).Value = "TempHeader" & i
            tempHeaders.Add i ' Store the column index of the header we changed
        End If
    Next i
    
  3. Apply auto filter like you do currently

  4. Clear values from temp headers after filter is applied:

    For Each th In tempHeaders
        ws.Cells(1, th).Value = ""
    Next th
    
like image 91
Michał Turczyn Avatar answered Dec 05 '25 13:12

Michał Turczyn


This is an Excel formula approach for this.
First filters on the Buyer column, and after it count the unique values of columns of Stores of specific Buyer one-by-one.
You can apply it in VBA with dynamic range, and arbitrary result on the boolean return value.

A B C D E F
Prim Store Sec Store Buyer
DDD AAA Mr.A Mr.A FALSE
FFF AAA Mr.A Mr.B TRUE
XXX YYY Mr.B
AAA AAA Mr.A
XXX YYY Mr.B
FFF DDD Mr.A

The spill formula is in cell E2.

=LET(uni,UNIQUE(C2:C7),
filt,MAP(uni,LAMBDA(x,IF(COUNTA(UNIQUE(CHOOSECOLS(FILTER(A2:C7,C2:C7=x),1,2)))>2,FALSE,TRUE))),
HSTACK(uni,filt))

or

=HSTACK(UNIQUE(C2:C7),IF(MAP(UNIQUE(C2:C7),LAMBDA(x,SUMPRODUCT(--(CHOOSECOLS(UNIQUE(A2:C7),3)=x))))=1,TRUE,FALSE))
like image 43
Black cat Avatar answered Dec 05 '25 12:12

Black cat



Donate For Us

If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!