What does this Code Actually do Please

[Paul Black]

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
Do While ActiveCell <> ""
nDupl = 0

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

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

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

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

 

[Bob Phillips]

Hi Everyone,

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

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 ...

It is looping through the activecell and 4 to the right and loading the
values in an array, reducing it to a maxd of 9 by decrements of 10

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 ...

This is looping through that array counting how many items are repeated.

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.

Odd? It is changing the number of duplicates found 1->2, 2->4, 4->5, etc.
This is presumably because it can double-count the items, for instance a
series of 1,2,1,1, the first 1 will find 2 duplicates, the second one will
find another one, double counting. However, there must a simpler method, and
it is flawed as the example I gave shows 3 duplicates when there are only 2
in reality, the case code doesn't cater for that.

I also cannot understand why 101 is considered a duplicate of 1.

 

[Guest]

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

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:

 

[Paul Black]

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

 

[Bob Phillips]

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)

 

[Guest]

Here is one approach:

Public Sub Test()
Dim i As Integer
Dim LastDigit As Integer
Dim DigitCounts(0 To 9) As Integer ' This will hold counters for each digit
0-9
Dim nDupl As Integer

Application.ScreenUpdating = False
Do While ActiveCell <> ""

' Initialize all digit counts to zero:
For i = 0 To 9
DigitCounts(i) = 0
Next i

' Read the row to find the duplicates:
For i = 0 To 4
' Formula finds the last digit without needing to loop; takes less time,
esp. for large numbers:
LastDigit = ActiveCell.Offset(0, i).Value - 10 * Int(ActiveCell.Offset(0,
i).Value / 10)
' This line increments the count for the current digit:
DigitCounts(LastDigit) = DigitCounts(LastDigit) + 1
Next i

' re-initialize the overall duplicate counter
nDupl = 0

' Loop through the array of digit counts:
For i = 0 To 9
' If the count is one, there is no duplicate; otherwise the count should
be added to the overall duplicate count:
If DigitCounts(i) > 1 Then nDupl = nDupl + DigitCounts(i)
Next i

ActiveCell.Offset(0, 5).Value = nDupl
ActiveCell.Offset(1, 0).Select

Loop
Application.ScreenUpdating = True
End Sub

 

[Paul Black]

Thank You Both Very Much for the Replies.

Bob,
For Some Reason I could Not get Yours to Work.

K Dales,
Yours Produces Exactly the Results I was Looking for.
Thank You Also for the Detailed Comments, Being New to VBA, it has
Certainly Helped me to Understand what is Happening and Why.

Thank You Both Again.
Have a Great Weekend.
All the Best.
Paul