CODEWITHSUNDEEP
excelvba
pseevs
pseevs

Reputation: 21

How to highlight duplicates in column that are not blanks?

I want to highlight all the duplicates of a concatenated string in column I and provide an error message if there are any duplicates highlighted. However, there are several blank cells in the column and I do not want these to show up as duplicates when I am running the macro.

I got this code from on here: 

Sub HighlightDuplicateValues()
    Dim myRange As Range

    Range("I1", Range("I1").End(xlDown)).Select

    Set myRange = Selection

    For Each myCell In myRange
        If Not IsEmpty(ActiveCell.Value) = True Then
            If WorksheetFunction.CountIf(myRange, myCell.Value) > 1 Then
                myCell.Interior.ColorIndex = 36
            End If    
        End If   
    Next myCell 
End Sub

I have absolutely no experience in VBA but from what little I understand it seems like it should work. However, what ends up happening is nearly all my data gets deleted. It's rather unfortunate.

Again, I want to highlight any duplicates in the concatenated column I, but I don't want these blank cells to count as duplicates. Having the code for an error message to pop up would be an excellent added bonus, but is not currently my main focus.

Upvotes: 1

Views: 722

Answers (1)

Warcupine
Warcupine

Reputation: 4640

If you want to use VBA this should work for you.

    Dim mydict As Object
    Dim iter As Long
    Dim lastrow As Long
    Dim errmsg As String
    Dim key As Variant

    Set mydict = CreateObject("Scripting.Dictionary")

    ' If you want to use early binding add in the Microsoft Scripting Runtime reference then: Set mydict = new dictionary

    With ActiveSheet
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For iter = 2 To lastrow
            If Not mydict.exists(.Cells(iter, "A").Value) Then
                mydict.Add .Cells(iter, "A").Value, False
            Else
                .Cells(iter, "A").Interior.ColorIndex = 36
                mydict(.Cells(iter, "A").Value) = True 'Keep track of which values are repeated
            End If
        Next
    End With
    errmsg = "Duplicate Values: "
    For Each key In mydict
        If mydict(key) = True Then 'Dupes
            If Not errmsg = "Duplicate Values: " Then 'No extra comma
                errmsg = errmsg & ", " & key
            Else
                errmsg = errmsg & " " & key
            End If
        End If
    Next

    MsgBox errmsg

Upvotes: 3

Related Questions