Duplicate values in a range, using VBA

[timburbidge]

Hi All

I'm looking for a formula/VBA code which will look through a range of values eg

T1Bc2
T1Ba1
T1Ba1
T1Ad1
T2Ea2
T2Ea2
T1Ab1
T1Ac1
T1Ba2
T1Ac3
T2Ea4
T2Ec4
T1Bb2
T1Ab2
T1Ab2
T1Ab2
T1Ab2
T1Ac1
T1Bc2

and return those values which appear more than once. So, if T1Ab2 appears 3 times, the result would be T1Ab2 = 2. Or, if none of the codes are duplicated, the result would be a nil return

Thanks very much

Tim

 

[Von Pookie]

There is probably a shorter way of doing it via code, but this seems to work for me. This is assuming the list starts in A1 and you want to place the results in column B:

Sub asdf()
Dim i As Long, LastRow As Long
Dim temp As Variant, x As Long

LastRow = Columns(1).Find("*", searchdirection:=xlPrevious).Row

For i = 1 To LastRow
    x = WorksheetFunction.CountIf(Range("A1:A" & LastRow), Cells(i, 1))
    If x > 1 Then
        If temp = "" Then
            temp = Cells(i, 1) & "=" & x
        Else
            If InStr(1, temp, Cells(i, 1)) = 0 Then
                temp = temp & "," & Cells(i, 1) & "=" & x
            End If
        End If
    End If
Next i

If temp = "" Then
    [B1] = 0
Else
    temp = Split(temp, ",")
    For i = LBound(temp) To UBound(temp)
        Cells(i + 1, 2) = temp(i)
    Next i
End If

End Sub

Alternately, you could just use a simple formula in column B to "tag" whether or not a cell is a duplicate. This would go in B1 and then you can just drag it down the column:
=IF(COUNTIF($A$1:$A$19,A1)>1,"Duplicate","")

 

[timburbidge]

thanks very much. i'll have a look through it and try to decipher. if you have time, some narrative in between the lines wouldn't hurt (cheeky!)

 

[Von Pookie]

Oh, no problem. I usually do that anyway; not sure why I didn't on this one.

At any rate, here's the exact same code with some comments to (hopefully) explain:

Sub asdf()
Dim i As Long, LastRow As Long
Dim temp As Variant, x As Long

'find last row with data in column A
'this is used as the stopping point of the list
LastRow = Columns(1).Find("*", searchdirection:=xlPrevious).Row

'assuming the data starts in row 1 and goes until the LastRow
'loop through the rows in the column
For i = 1 To LastRow
    'count the number of times the value of the cell appears in the range
    x = WorksheetFunction.CountIf(Range("A1:A" & LastRow), Cells(i, 1))
    
    'if it appears in the range more than 1 time...
    If x > 1 Then
        'add the value of the cell and the number of occurances to a string
        
        'if the string value is empty
        If temp = "" Then
            'just add the value/# of occur.
            temp = Cells(i, 1) & "=" & x
        'if the string value already contains text
        Else
            'check to see if the value of the cell is already in the list
            'if it is *not* in the list...
            If InStr(1, temp, Cells(i, 1)) = 0 Then
                'add the value/# of occur. onto the end of the string
                'each item separated by a comma
                temp = temp & "," & Cells(i, 1) & "=" & x
            End If
        End If
    End If
Next i

'once all of the values have been checked

'if the string variable is empty, no duplicates were found
If temp = "" Then
    'display a 0
    [B1] = 0
'if variable is *not* empty
Else
    'split string variable into array, separated by the commas in the string
    temp = Split(temp, ",")
    'loop through the items in the array
    For i = LBound(temp) To UBound(temp)
        'place the value/# of occur. in column B
        Cells(i + 1, 2) = temp(i)
    Next i
End If

End Sub

 

[timburbidge]

Thanks very much for the narrative. I've pasted it into excel, but it's not liking the split near the end - "not defined"??

 

[gaj104]

The formula way is probably better if you're not so confident with VBA

Book3
	A	B	C	D
1	Data	Number of duplicates
2	T1Bc2	1
3	T1Ba1	1
4	T1Ba1	1
5	T1Ad1	-
6	T2Ea2	1
7	T2Ea2	1
8	T1Ab1	-
9	T1Ac1	1
10	T1Ba2	-
11	T1Ac3	-
12	T2Ea4	-
13	T2Ec4	-
14	T1Bb2	-
15	T1Ab2	3
16	T1Ab2	3
17	T1Ab2	3
18	T1Ab2	3
19	T1Ac1	1
20	T1Bc2	1
Sheet1

Hope it helps

 

[pgc01]

Hi Tim

Here is another solution. Gets the input from A2 down and writes the results in columns C:D row 2 down.

Sub MoreThanOnce()
Dim rCell As Range, rRng As Range, vKey, lrow As Long

Set rRng = Range("A2", Range("A" & Rows.Count).End(xlUp))

With CreateObject("Scripting.dictionary")
    .comparemode = vbTextCompare
    
    ' load the info
    For Each rCell In rRng
        If Not .exists(rCell.Value) Then _
            .Add rCell.Value, Application.WorksheetFunction.CountIf(rRng, rCell.Value)
    Next rCell

    ' Write the result in columns C:D
    lrow = 2
    For Each vKey In .keys
        If .Item(vKey) > 1 Then
            Cells(lrow, "C") = vKey
            Cells(lrow, "D") = .Item(vKey) - 1
            lrow = lrow + 1
        End If
    Next vKey
End With
End Sub

Hope this helps
PGC