Highlighting only the 2nd+ instance of a duplicate in a range

[AskMyDog]

Hi again,

Thank you to those heroes that helped me with my question earlier today, but I've got another one.

I'm trying to get this macro to highlight ONLY the 2nd, 3rd, 4th etc instance of a duplicate. I've since reverted to the original formula, but adding in a For...Each counter didn't seem to make any difference, nor did playing around with the placement of the color change.

Here's the code:

Sub Highlight_Duplicates()

Dim lotarget As ListObject
Dim Name_Col As Range, Dupl_Rng As Range
Dim Dupl_cell As Range
Dim TableRows As Long
Dim First_Dupl As String


Set lotarget = Worksheets("Reconcile Meds Here").ListObjects("Table3")

TableRows = lotarget.ListRows.Count
Set Name_Col = lotarget.Range.Columns(1)
Range("C7:c200").ClearFormats
lotarget.TableStyle = "TableStyleMedium2"


For Each Dupl_cell In Name_Col.Cells
If WorksheetFunction.CountIf(Name_Col, Dupl_cell.Value) > 1 Then
Set Dupl_Rng = Name_Col.Find(What:=Dupl_cell.Value, LookIn:=xlValues)
If Not Dupl_Rng Is Nothing Then
First_Dupl = Dupl_cell.Address
Do
Set Dupl_cell = Name_Col.FindNext(Dupl_cell)
Dupl_cell.Interior.ColorIndex = 35
Loop While Not Dupl_cell Is Nothing And Dupl_cell.Address <> First_Dupl

End If
End If
Next

End Sub

Thanks again!

 

[RickXL]

Hi,

I did not quite follow your code but see if you can adapt this.

Sub Highlight_Duplicates()
    Dim Key     As Variant
    Dim i       As Long
    Dim dic     As Object
    Dim arr     As Variant
    Dim cIndex  As Integer

    Set dic = CreateObject("Scripting.Dictionary")
    With ThisWorkbook.Worksheets("Reconcile Meds Here").ListObjects("Table3")
        arr = .ListColumns(1).DataBodyRange.Value
        For i = 1 To UBound(arr)
            Key = arr(i, 1)
            dic(Key) = dic(Key) + 1
            If dic(Key) > 1 Then cIndex = 35 Else cIndex = 0
            .DataBodyRange(i, 3).Interior.ColorIndex = cIndex
        Next
    End With
End Sub

I think you are trying to locate the duplicates in column 1 of a Table/ListObject called Table3.
The macro starts by copying that column into an array called arr.
It then creates an output array called ARr2 which is the same size as arr.

It then loops round arr.
Every value is treated as a Key.
The Keys are written to a Dictionary Object which notes the Keys and how many times it has been added to the Dictionary.
If there is a duplicate then the ColorIndex is set to 35 else it is set to 0.

 

[AskMyDog]

Rick,

This is a fascinating way to solve this problem. I've never heard of being able to create a dictionary, but then again, I am NOT an Excel VBA wizard.

Unfortunately, it didn't seem to work when I plugged it into my spreadsheet and tried to run it, but now that I think about it, it was highlighting a couple of cells to the right of the column of interest. I didn't see anything in your code which would cause that to happen. Any thoughts?

 

[RickXL]

Sorry, I could not work out which cells you were highlighting - so I guessed.

Here is the relevant line of code:

.DataBodyRange(i, 3).Interior.ColorIndex = cIndex

It highlights the cell on row i column 3 of the Table.
Please change as appropriate.

Dictionaries

Strictly, they are not part of VBA but if you are on a PC they can be used by VBA. They work a bit like, well, a dictionary! There is a key and an item. The key would be the word in a conventional dictionary and the item would be the definition.

They have been designed to be direct access so if you know a key you can quickly find the associated item. In the example, each time a value is located it tries to add it to the dictionary. Each time a key is processed it increments the associated item by one. So to find the number of times that a key has been referenced you just need to view the item for that key.

 

[AskMyDog]

RickXL

Thank you so my for opening my eyes to the dictionary!

If you are able (and I completely understand if you're not, since you've already helped me so much), can you take a look at this?

I'm trying to replicate your work with another portion of my table, but instead search for different words separated by commas. It keeps on saying "array expected" for the line starting with arr1. Here's the code.

With Worksheets("Reconcile Meds Here").ListObjects("Table3")

For g = 1 To lastRow1
arr = .ListColumns("Medication Type").DataBodyRange(g, Type_Col)
arr1(h) = Split(arr(g), ", ")
For h = 1 To UBound(arr1)
Key = LCase(arr1(h))
dic(Key) = dic(Key) + 1
If dic(Key) > 1 Then
.ListRows(g).Range.Interior.ColorIndex = 22
End If
Next
Next

I'm getting the feeling that I am totally missing how to use dictionaries, but I am really excited about using them!

Any thoughts?

 

[RickXL]

OK, I have made some guesses which may not apply ...

Sub test()

    Dim g           As Long
    Dim lastRow1    As Long
    Dim arr         As Variant
    Dim h           As Long
    Dim arr1        As Variant
    Dim dic         As Object
    Dim Key         As String
    Dim Type_Col    As Long
    
    Set dic = CreateObject("Scripting.Dictionary")

    With Worksheets("Reconcile Meds Here").ListObjects("Table3")
        Type_Col = 1
        For g = 1 To .ListRows.Count
            dic.RemoveAll
            arr = .ListColumns("Medication Type").DataBodyRange(g, Type_Col)
            arr1 = Split(arr, ", ")
            For h = LBound(arr1) To UBound(arr1)
                Key = LCase(arr1(h))
                dic(Key) = dic(Key) + 1
                If dic(Key) > 1 Then
                    .ListRows(g).Range.Interior.ColorIndex = 22
                End If
            Next
        Next
    End With

End Sub

if the line:

arr = .ListColumns("Medication Type").DataBodyRange(g, Type_Col)

has g and Type_Col as integers then arr will be only one cell - so it could be a string instead of a variant.

The Split line will take the one value (with words separated by commas) and turn into an array. By default, the lower bound of the array will be 0 - so I used LBound().

The Dictionary will now count total words since it was created. I guessed that you only want to find duplicate words in one cell. In which case you will need to empty the Dictionary before you process the next row. That is what the:

dic.RemoveAll

line does.