Labeling a column's values by its criteria based on 2 different columns

Question

Hoping that everyone is having a good one. (This is a continuation of another question I asked which can be found here: Does Excel VBA's "Scripting.Dictionary" work in languages other than English?)
I'm hoping that this will be the last question that I will ask about this macro that I am trying to make since I don't want to trouble people too much.

I was thinking that it would be better to clear a column and label each buyer respectively if they have conflicting stores or not. So far, I have this code that a few people have helped me with...

Private Sub Check_RR()

    Application.ScreenUpdating = False
    If Not Cells(2, 8).Value = "WS_Sales" Then
        End
    End If
    
    AROW = ActiveCell.row
    ACOL = ActiveCell.Column
    
'Uniqueエンドユーザー
    Dim wsActive As Worksheet
    Dim lastRow As Long
    Dim buyerStoreMap As Object
    Dim buyerName As String
    Dim rowIndex As Long
    Dim storePairKey As String
    Dim storePairDict As Object
    Dim selectedBuyer As String
    Dim isBuyerFound As Boolean
    Dim activeRow As Long

'S列クリアする
    Range("S3", Range("S" & Rows.Count).End(3)).ClearContents

'WorksheetとDictionary
    Set wsActive = ThisWorkbook.ActiveSheet
    lastRow = wsActive.Cells(wsActive.Rows.Count, "G").End(xlUp).row
    Set buyerStoreMap = CreateObject("Scripting.Dictionary")

'エンドユーザーの一次店と二次店の組み合わせ
    For rowIndex = 1 To lastRow
        buyerName = Trim(wsActive.Cells(rowIndex, "G").Value)
        If buyerName <> "" Then
            storePairKey = wsActive.Cells(rowIndex, "C").Value & "|" & wsActive.Cells(rowIndex, "E").Value
            If Not buyerStoreMap.Exists(buyerName) Then
                Set storePairDict = CreateObject("Scripting.Dictionary")
                buyerStoreMap.Add buyerName, storePairDict
            End If
            buyerStoreMap(buyerName)(storePairKey) = 1
        End If
    Next rowIndex

'エンドユーザー
    For rowIndex = 1 To lastRow
        buyerName = Trim(wsActive.Cells(rowIndex, "G").Value)
        If buyerName <> "" Then
            If buyerStoreMap.Count > 1 Then
                wsActive.Cells(rowIndex, "S").Value = "コンフリ有り"
            Else
                wsActive.Cells(rowIndex, "S").Value = "コンフリ無し"
            End If
        End If
    Next rowIndex

'S列に「コンフリ有/無」をラベルします
        
    
    
'フィルターをかける
    If wsActive.AutoFilterMode Then wsActive.AutoFilter.ShowAllData
    wsActive.Range("A1:G" & lastRow).AutoFilter Field:=7, Criteria1:=ActiveCell

'The code continues with more filters that will have the needed outcome.

The important part that I need help with is the top part, wherein the data in Column G will be labeled as "Conflict/No Conflict(but in Japanese ahaha)" in Column S depending on the store combination in Columns C and E. If it's easier to not put a label on non-conflicted buyers, that's fine too. Also, the Dictionary that I currently have always ends up being Empty. I might need a bit of assistance there too. I'm very sorry for the trouble! Also, is it okay to put filter over filter like how I did in my current code? As someone who is learning, I would love some advice. I appreciate you all very much. Thank you in advance.

Reading through your code, it sounds like if the same buyer is listed for identical store1 and store2 pair, then that should be a conflict, because the count would be >1, is that correct? And if that is correct, why does the screenshot show the opposite where it only shows "Conflict" if that is not the case? — tigeravatar
– tigeravatar, Commented Jul 18 at 13:40
If you do just want to check count of same buyer for same store1|store2 pairs, you can do so with a simple COUNTIFS function. You could put this in cell S3 and copy down: =IF(COUNTIFS(G:G,G3&"",C:C,C3&"",E:E,E3&"")>1,"Conflict","") — tigeravatar
– tigeravatar, Commented Jul 18 at 13:41
Hello, tigeravatar. I wanted to make a macro that will filter ONLY Buyers that have 1 combination of stores. If the Buyer has more than 1 combination, they will be marked as "Conflict". I think you may have misunderstood the outcome that I wanted. I apologize if my explanation wasn't clear enough. — Anpo Desu
– Anpo Desu, Commented Jul 22 at 0:45

Michał Turczyn · Accepted Answer · 2025-07-18 10:37:43Z

1

Here's sub that would put appropriate information in S column. I have put inline comments for clarity.

The approach is similiar to what you have presented:

Sub PopuateWithAdditionalInformationAbutConflictingStores()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim dict As Object
    Dim i As Long
    Dim buyer As String
    Dim uniquePair As String
    Dim pairsDict As Object

    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

    ' Loop once again over buytes and check if they
    ' have conflicts and put information in S column
    For i = 2 To lastRow ' Assuming headers in row 1
        buyer = Trim(ws.Cells(i, "G").Value)
        If buyer <> "" Then
            If dict(buyer).Count > 1 Then
                ws.Cells(i, "S").Value = "CONFLICT"
            Else
                ws.Cells(i, "S").Value = "NO CONFLICT"
            End If
        End If
    Next i
End Sub

answered Jul 18 at 10:37

Michał Turczyn

41.2k18 gold badges58 silver badges87 bronze badges

Sign up to request clarification or add additional context in comments.

9 Comments

Anpo Desu Jul 22 at 0:39

Hello, Michał. I appreciate your guidance, as always. I wanted to inform you that with the code that you have provided, it keeps jumping over the "Build Dictionary" part. Would there be a reason why this happens? Thank you so much again, and I apologize for the trouble.

Michał Turczyn Jul 22 at 5:54

Most porbably is that lastRow is 1, so the loop is skipped altogether. What values you have in G column? In order to debug you can always write MsgBox lastRow to see its value

Anpo Desu Jul 22 at 6:42

I see now. It's skipping it due to an empty 'almost empty' row 2 (the purple bar) that can be seen in the screenshot that I have provided. Would be the best way to deal with this is by using the IsEmpty?

Michał Turczyn Jul 22 at 6:46

What does it show if you add MsgBox lastRow just before the loop

Anpo Desu Jul 22 at 6:53

If the MsgBox is before the loop, it's "1". And after, it is also "1". It seems that due to the double-header problem, the loop just skips every other cell in Column G.

Michał Turczyn Jul 22 at 6:55

lastRow = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row will always find the last row in the column, regardless if there are blank cells along the way, so if you have entire G column empty, but on row 133 there will be value, lastRow will be 133. So you must have messed something up and it's impossible for me to tell you what.

Anpo Desu Jul 22 at 6:57

I understand. I will change the code above to the current code. I hope this can be a bit more helpful. I apologize for the trouble.

Anpo Desu Jul 22 at 7:02

I have updated the original post's code into the latest one that I have.

Anpo Desu Jul 28 at 2:02

Hello, Michał! I appreciate you for guiding me through so many coding difficulties that I have encountered. I have learned so much from your patience. I have the weirdest mistake, that was why the code was not working. I was using "ThisWorkbook.ActiveSheet" instead of "ActiveWorkbook.ActiveSheet". I still have so much to learn. Thank you again!

tigeravatar · Accepted Answer · 2025-07-18 14:03:12Z

As a follow-up to my comments regarding using COUNTIFS instead of a dictionary, here is a solution if you require the use of VBA:

Sub tgr()
    
    Const lStartRow As Long = 3 'This is the row your actual data starts on, excludes headers
    
    'Define workbook and worksheet
    Dim wb As Workbook:     Set wb = ThisWorkbook
    Dim ws As Worksheet:    Set ws = wb.ActiveSheet
    
    'Get last row and check if data exists
    Dim lLastRow As Long
    lLastRow = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row
    If lLastRow <= lStartRow Then Exit Sub  'No data
    
    ws.Range("S" & lStartRow & ":S" & ws.Rows.Count).ClearContents  'Clear previous data in column S
    With ws.Range(ws.Cells(lStartRow, "S"), ws.Cells(lLastRow, "S"))
        'Put the formula in column S
        .Formula = "=IF(COUNTIFS(G:G,G" & .Row & "&"""",C:C,C" & .Row & "&"""",E:E,E" & .Row & "&"""")>1,""Conflict"","""")"
        .Value = .Value  'Convert column S to values (so the sheet doesn't show the formula, this step is optional)
    End With
    
    'Rest of your code here for the msgboxes and autofilters
    
End Sub

Collectives™ on Stack Overflow

Labeling a column's values by its criteria based on 2 different columns

2 Answers 2

9 Comments

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

9 Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related