VBA Code To Highlight Duplicate Values In A Column

[shonu]

Hello,

My current vba code is finding the duplicate strings however only if they are in a sequence which is one after another. If it is out of sequence it does not work. So if the word Walter is repeated one after another it works. However if you put John in between it does not work. Please see the below code I have:


Sub FindDups ()

ScreenUpdating = False
FirstItem = ActiveCell.Value
SecondItem = ActiveCell.Offset(1, 0).Value
Offsetcount = 1
Do While ActiveCell <> ""
If FirstItem = SecondItem Then
ActiveCell.Offset(Offsetcount,0).Interior.Color = RGB(255,0,0)
Offsetcount = Offsetcount + 1
SecondItem = ActiveCell.Offset(Offsetcount, 0).Value
Else
ActiveCell.Offset(Offsetcount, 0).Select
FirstItem = ActiveCell.Value
SecondItem = ActiveCell.Offset(1,0).Value
Offsetcount = 1
End If
Loop
ScreenUpdating = True
End Sub

[MARK858]

If you are try to highlight all the duplicates then you can try the code below. It is set up for Column C, to change the column change the bits in red


Sub DupIt()
Dim Rng As Range
Dim cel As Range
Set Rng = Range(Range("C1"), Range("C" & Rows.Count).End(xlUp))
For Each cel In Rng
If WorksheetFunction.CountIf(Rng, cel.Value) > 1 Then
cel.Interior.ColorIndex = 3
End If
Next cel
End Sub

[LalitPandey87]

You can also try this:-



Option Explicit


Sub lm()

Dim rngRange As Range
Dim rngFirstRange As Range
Dim rngToFind As Range

Const strStringToFind As String = "a"

With ThisWorkbook.Worksheets("Sheet1")
Set rngToFind = .Range("A1").CurrentRegion
With rngToFind
Set rngRange = .Find(strStringToFind, LookIn:=xlValues, lookat:=xlWhole)
If Not rngRange Is Nothing Then
Set rngFirstRange = rngRange
Do
rngRange.Interior.ColorIndex = 3
Set rngRange = .FindNext(rngRange)
Loop While Not rngRange Is Nothing And rngRange.Address <> rngFirstRange.Address
End If
End With
End With

Set rngRange = Nothing
Set rngFirstRange = Nothing
Set rngToFind = Nothing

End Sub

:cheers:

[Admin]

Hi

If you are 2007+ then why don't use conditional formatting to highlight duplicates ?

[shonu]

Thanks Everyone, using excel 2003 unfortunately at work....

[MARK858]

Thanks Everyone, using excel 2003 unfortunately at work....
The codes in posts #2 and #3 are 2003 compatible. Did they not work for you?
If not what are your issues with the codes?

[Rick Rothstein]

If the data in Column C (the column I am assuming you want to check for doubles... change the highlighted C's to the actual column letter for your data) is all text, that is, no formulas, then here is one more macro for you to try (this one uses no loops and should be fast... no promises on that though)...

Sub MarkDuplicates()
Dim Addr As String
Addr = "C1:C" & Cells(Rows.Count, "C").End(xlUp).Row
Range(Addr) = Evaluate("IF(COUNTIF(" & Addr & "," & Addr & ")>1,""=""&" & Addr & "," & Addr & ")")
On Error Resume Next
Range(Addr).SpecialCells(xlFormulas).Interior.Colo rIndex = 6
Range(Addr).Replace "=", "", xlPart
End Sub

By the way, if your data column does contain formulas, I can modify the code to account for that... just let me know.