Assign Count and Row Values to a Dictionary

kylohansolo 0
Viewed 24

I want to find two equal and opposite values in a given range and highlight both of them.

Just got know that VBA has Dictionary as well and tried to solve the problem using that.

I don't want to publish working data to a sheet but not sure how to do it like I can do in Python by assigning a list to a Dictionary.

I saw an answer to a similar question but it ignores the fact there might more than 1 entries (like 10,10, -10).

I want to only highlight if there is no confusion regarding the pair (the range has 32 and -32 only).

So far I have done the basic work:

Dim dict As Object
Dim cl As Range, rng As Range
Set dict = CreateObject("Scripting.Dictionary")

Set rng = Range("AH" & AbsStart & ":AH" & AHEnd)

For Each cl In rng.Cells
    dict(cl.Row) = dict(cl.Row) + 1
Next

Dim VarKey As Variant

For Each VarKey In dict.Keys()
    If dict(VarKey) = 2 Then
        
    
Next
dictionary vba excel
1 Answers

Try this - using a dictionary to track already-matched cells:

Sub HiliteMatches()

    Dim dict As Object, rng As Range, arr, r As Long, r2 As Long
    Dim ws As Worksheet
    
    Set dict = CreateObject("Scripting.Dictionary")
    
    Set ws = ActiveSheet
    Set rng = ws.Range("A1:A10") 'for example
    arr = rng.Value
    
    For r = 1 To UBound(arr, 1)
        If Not dict.Exists(r) Then            'cell already flagged?
            For r2 = r + 1 To UBound(arr, 1)
                If Not dict.Exists(r2) Then
                    If arr(r, 1) = -arr(r2, 1) Then
                        dict.Add r2, True
                        rng.Cells(r).Interior.Color = vbYellow
                        rng.Cells(r2).Interior.Color = vbYellow
                        Exit For              'stop after one match
                    End If
                End If  'cell not flagged
            Next r2
        End If          'cell not flagged
    Next r

End Sub
useryB020
Related