Find duplicate entries that have trailing digit that may change.

  • Thread starter Thread starter DENNIS SHEROW
  • Start date Start date
D

DENNIS SHEROW

I found a macro to highlight duplicates and it is excellent! I need to
take it a step further and was hoping you could help.

This is what I need to do.

I need to find and highlight a number with mixed digits and characters such
as this example. 12345678ABCD0001. Your current version does that. Here
is the problem I have. I need not only find exact duplicates but also need
to find duplicates that may have a trailing such as 1,2,3,4,5,6 etc. and
still will pick it up as duplicate as this is a release number. Now, I
figure there are 2 ways you could do this but I am not sure. One, is to
drop the last digit then search for all duplicates. Two, to search on the
1st 8 digits only.

So, do you have any idea how to do this based on the current duplicate/find
macro below?

Sub GetDuplicates()
'
Range("A1:A100").Select
For Each Rng In Selection.Cells
If Application.WorksheetFunction.CountIf( _
Selection, Rng) > 1 Then
Rng.Interior.ColorIndex = 6 'yellow
Else
Rng.Interior.ColorIndex = 2 'white
End If
Next Rng
 
Try this:

Sub GetDuplicates()
'
Dim myNewRange
Dim Rng As Range
Range("A1:A100").Select
Set myNewRange = Nothing
For Each Rng In Selection.Cells
If Application.WorksheetFunction.CountIf( _
Selection, Rng) > 1 Then
Rng.Interior.ColorIndex = 6 'yellow
Else
Rng.Interior.ColorIndex = 2 'white
End If

'Defines a new range with one less character
If myNewRange = Nothing Then
myNewRange = Left(Rng, Len(Rng) - 1)
Else
myNewRange = Union(myNewRange, Left(Rng, Len(Rng) - 1))
End If
Next Rng

'Checks for duplicates with range that's 1 character less
For Each Rng In myNewRange
If Application.WorksheetFunction.CountIf( _
myNewRange, Rng) > 1 Then
Rng.Interior.ColorIndex = 6 'yellow
Else
'Rng.Interior.ColorIndex = 2 'white I'm not sure you need this.
End If

Next Rng


End Sub


HTH,
Barb Reinhardt
 
Back
Top