Assuming that you still want the activecell and four cells right then this
works

Sub CountDuplicates()
Dim iRow As Long
Dim icol As Long
Dim nDups As Long
Dim i As Long, j As Long
Dim fDups As Boolean
Dim aryNums

iRow = ActiveCell.Row: icol = ActiveCell.Column
aryNums = Range(Cells(iRow, icol), Cells(iRow, icol + 4))
For i = 1 To 5
fDups = False
For j = i + 1 To 5
If aryNums(1, i) < "" Then
If aryNums(1, i) = aryNums(1, j) Then
aryNums(1, j) = ""
fDups = True
End If
End If
If fDups Then nDups = nDups + 1
Next j
Next i
Cells(iRow, icol + 5).Value = nDups
End Sub

--

HTH

RP
(remove nothere from the email address if mailing direct)


"Paul Black" wrote in message
oups.com...
Thank You Bob & K Dales for your Explanations & Time.

Is it Complicated to get the Code to Avoid the Double Counts and Loop
through the Columns Only Once?.

Thanks in Advance.
All the Best.
Paul



K Dales wrote:
It doesn't exactly test for duplicates; it tests for how many cells in
the
row have the same final digit (e.g. 5, 45, and 125 all end in 5).

See the rest of my comments inserted below; hopefully I can clarify what
is
happening:
--
- K Dales


"Paul Black" wrote:

Hi Everyone,

I found this Code that Seems to Test for Duplicates :-

Sub Test_Dupl()
Dim i As Integer
Dim j As Integer
Dim nDupl As Integer
Dim nNum(5) As Integer

Application.ScreenUpdating = False
' Turns any screen updating off to hide processing/eliminate flicker
Do While ActiveCell < ""
' This will loop (through the rows) until it finds an empty cell
nDupl = 0

For I = 1 To 5
' This is looping through 5 columns starting at the current active cell
nNum(i) = ActiveCell.Offset(0, i - 1).Value
' nNum(1) has the active cell value stored, nNum(2) the 2nd column's
value,
etc.
Do Until nNum(i) < 10
' This loop finds the final digit of the cell value by repeatedly
subtracting 10 until the result is 0-9
nNum(i) = nNum(i) - 10
Loop
Next i

For i = 1 To 4
' Now the code loops through the 1st 4 values in nNum - the final digit
of
the cells in columns 1-4 (don't need col 5 here because the further code
checks only to the right of this column; it does not need to check
column 6
or greater)
For j = I + 1 To 5
' This j loop is looping through the columns to the right of the
current
i value column (so it can look for the repeated values)
If nNum(i) = nNum(j) Then
' nNum(i) would be the rightmost digit in the cell being checked,
nNum(j)
the digit from the column we are currently looking at
' If it finds a repeated value add 1 to the count of repeats (stored
in
nDupl)
nDupl = nDupl + 1
End If
Next j
Next i

Select Case nDupl
' Now the code converts the count of repeats into a count of duplicate
values; it has to do this because the count obtained above has 2
problems:
the first "repeat" actually means there are 2 duplicate values; plus as
it
loops through the columns twice it will count everything twice. So both
effects need to be corrected for and that is what is happening below
(the
code author apparently figured what the result would be for any actual
combination and is hard-coding the corrections). (This is actually an
inefficiency in the coding, it could have been written differently to
avoid
the double counts and to also loop only once through the columns)
Case 1
nDupl = 2
Case 2
nDupl = 4
Case 4
nDupl = 5
Case 6
nDupl = 4
Case 10
nDupl = 5
End Select

' Now put the count in column 5 and move to the next row:
ActiveCell.Offset(0, 5).Value = nDupl
ActiveCell.Offset(1, 0).Select

Loop
Application.ScreenUpdating = True
End Sub

Could Somebody Kindly Explain what the ...

For I = 1 To 5
nNum(i) = ActiveCell.Offset(0, i - 1).Value
Do Until nNum(i) < 10
nNum(i) = nNum(i) - 10
Loop
Next i

Bit of Code is Actually doing, and the ...

For i = 1 To 4
For j = I + 1 To 5
If nNum(i) = nNum(j) Then
nDupl = nDupl + 1
End If
Next j
Next i

Bit of Code is Actually doing, and ...

Select Case nDupl
Case 1
nDupl = 2
Case 2
nDupl = 4
Case 4
nDupl = 5
Case 6
nDupl = 4
Case 10
nDupl = 5
End Select

the Bit of Code is Actually doing Please.

Any Help will be Greatly Appreciated.
All the Best.
Paul