How can this code be shorted excel 2003

[AC]

The code checks for duplicate in 16 named ranges and colors the duplicates in each range green and lets me know if any were found. With my limited knowledge of VBA I got this to work, but I bet there is a better way to do it, any thoughts

Sub CheckDups()
'checks for duplicate numbers
    Dim Rng As Range
    Dim Msg As String
    Dim Dup As Integer
    Dim CardRange As String
    
    Dup = 0
    For Each Rng In Range("Card1").Cells
        If Application.WorksheetFunction.CountIf( _
            Range("Card1"), Rng) > 1 Then
            Rng.Interior.ColorIndex = 4 'Green
        End If
    Next Rng
    
        For Each Rng In Range("Card2").Cells
        If Application.WorksheetFunction.CountIf( _
            Range("Card2"), Rng) > 1 Then
            Rng.Interior.ColorIndex = 4 'Green
        End If
    Next Rng
    
            For Each Rng In Range("Card3").Cells
        If Application.WorksheetFunction.CountIf( _
            Range("Card3"), Rng) > 1 Then
            Rng.Interior.ColorIndex = 4 'Green
        End If
    Next Rng


        For Each Rng In Range("Card4").Cells
        If Application.WorksheetFunction.CountIf( _
            Range("Card4"), Rng) > 1 Then
            Rng.Interior.ColorIndex = 4 'Green
        End If
    Next Rng


        For Each Rng In Range("Card5").Cells
        If Application.WorksheetFunction.CountIf( _
            Range("Card5"), Rng) > 1 Then
            Rng.Interior.ColorIndex = 4 'Green
        End If
    Next Rng


        For Each Rng In Range("Card6").Cells
        If Application.WorksheetFunction.CountIf( _
            Range("Card6"), Rng) > 1 Then
            Rng.Interior.ColorIndex = 4 'Green
        End If
    Next Rng


        For Each Rng In Range("Card7").Cells
        If Application.WorksheetFunction.CountIf( _
            Range("Card7"), Rng) > 1 Then
            Rng.Interior.ColorIndex = 4 'Green
        End If
    Next Rng


        For Each Rng In Range("Card8").Cells
        If Application.WorksheetFunction.CountIf( _
            Range("Card8"), Rng) > 1 Then
            Rng.Interior.ColorIndex = 4 'Green
        End If
    Next Rng


        For Each Rng In Range("Card9").Cells
        If Application.WorksheetFunction.CountIf( _
            Range("Card9"), Rng) > 1 Then
            Rng.Interior.ColorIndex = 4 'Green
        End If
    Next Rng


        For Each Rng In Range("Card10").Cells
        If Application.WorksheetFunction.CountIf( _
            Range("Card10"), Rng) > 1 Then
            Rng.Interior.ColorIndex = 4 'Green
        End If
    Next Rng


        For Each Rng In Range("Card11").Cells
        If Application.WorksheetFunction.CountIf( _
            Range("Card11"), Rng) > 1 Then
            Rng.Interior.ColorIndex = 4 'Green
        End If
    Next Rng


        For Each Rng In Range("Card12").Cells
        If Application.WorksheetFunction.CountIf( _
            Range("Card12"), Rng) > 1 Then
            Rng.Interior.ColorIndex = 4 'Green
        End If
    Next Rng


        For Each Rng In Range("Card13").Cells
        If Application.WorksheetFunction.CountIf( _
            Range("Card13"), Rng) > 1 Then
            Rng.Interior.ColorIndex = 4 'Green
        End If
    Next Rng


        For Each Rng In Range("Card14").Cells
        If Application.WorksheetFunction.CountIf( _
            Range("Card14"), Rng) > 1 Then
            Rng.Interior.ColorIndex = 4 'Green
        End If
    Next Rng


        For Each Rng In Range("Card15").Cells
        If Application.WorksheetFunction.CountIf( _
            Range("Card15"), Rng) > 1 Then
            Rng.Interior.ColorIndex = 4 'Green
        End If
    Next Rng
    
            For Each Rng In Range("Card16").Cells
        If Application.WorksheetFunction.CountIf( _
            Range("Card16"), Rng) > 1 Then
            Rng.Interior.ColorIndex = 4 'Green
        End If
    Next Rng


CardRange = "Card1,Card2,Card3,Card4,Card5,Card6,Card7,Card8,Card9,Card10,Card11,Card12,Card13,Card14,Card15,Card16"
For Each Rng In Range(CardRange).Cells
        If Rng.Interior.ColorIndex = 4 Then
         Dup = 1
        End If
        Next Rng
If Dup = 1 Then
MsgBox "There Are Duplicate Numbers In The Cards, They Have Been Marked In Green" & vbLf & _
"Fix Them And Then Click On Reset Cards", , "Duplicates In Cards"
End If

End Sub

 

[njimack]

This (untested) code should work. Also, you should set calculation to manual and screenupdating to false at the start of your code, then reset them at the end of your code...

Sub CheckDups()
'checks for duplicate numbers
    Dim Rng As Range
    Dim Msg As String
    Dim Dup As Integer
    Dim CardRange As String
    Dim i As Integer
 
    Dup = 0
 
    For i = 1 To 15
 
        For Each Rng In Range("Card" & i).Cells
            If Application.WorksheetFunction.CountIf( _
                Range("Card1"), Rng) > 1 Then
                Rng.Interior.ColorIndex = 4 'Green
            End If
        Next Rng
 
    Next i

 

[Jonmo1]

I like njimack's solution, but you need to incorporate the i variable in BOTH places referring to the named range..

Also, I notice you loop through each range twice.
16 loops (1 for each range) to color dupes green.
Then ANOTHER loop through ALL of them testing for Green
You can do that all in one.

Try

Sub CheckDups()
'checks for duplicate numbers
Dim Rng As Range, i As Long, Dup As Boolean
Dup = False
For i = 1 To 16
    For Each Rng In Range("Card" & i).Cells
        If Application.WorksheetFunction.CountIf( _
            Range("Card" & i), Rng) > 1 Then
            Rng.Interior.ColorIndex = 4 'Green
            Dup = True
        End If
    Next Rng
Next i
If Dup Then
    MsgBox "There Are Duplicate Numbers In The Cards, They Have Been Marked In Green" & vbLf & _
    "Fix Them And Then Click On Reset Cards", , "Duplicates In Cards"
End If
End Sub

 

[AC]

Thanks, I thought there would be a better way