S
Ste Mac
Hi, I have this code (not written by me) it counts duplicates just
fine
but the outcome looks like this...
Number Occurence
13113 4
13113 4
13113 4
13113 4
6626 3
6626 3
6626 3
etc
I would like it to look like this: Can any kind soul help out?
Number Occurence
13113 4
6626 3
etc
The code..
Public Sub a1a1a1()
Dim v As Variant, r As Range, i As Long, j As Long
Dim ThecellRange As Range
Dim startcell, endcell, clearrange As Range
Sheets("Locations").Select
Sheets("Locations").Range("A1").Select
On Error Resume Next
reallastrow = Cells.Find("*", Range("A1"), xlFormulas, , xlByRows,
xlPrevious).Row
reallastcol = Cells.Find("*", Range("A1"), xlFormulas, ,
xlByColumns, xlPrevious).Column
Set endcell = Cells(reallastrow, reallastcol)
Set startcell = Sheets("Locations").Range("C6")
Set ThecellRange = Range(startcell, endcell)
Set r = ThecellRange
v = r.Value
For i = 1 To UBound(v, 1)
For j = 1 To UBound(v, 2)
If Application.WorksheetFunction.CountIf(r, v(i, j)) > 1 Then
r(i, j).Interior.ColorIndex = 6
Sheets("Locations").Range("A" & Rows.Count).End(xlUp).Offset(1,
0).Value = r(i, j)
Sheets("Locations").Range("B" & Rows.Count).End(xlUp).Offset(1,
0).Value = Application.WorksheetFunction.CountIf(r, v(i, j))
End If
Next j
Next i
End Sub
Cheers
Ste
fine
but the outcome looks like this...
Number Occurence
13113 4
13113 4
13113 4
13113 4
6626 3
6626 3
6626 3
etc
I would like it to look like this: Can any kind soul help out?
Number Occurence
13113 4
6626 3
etc
The code..
Public Sub a1a1a1()
Dim v As Variant, r As Range, i As Long, j As Long
Dim ThecellRange As Range
Dim startcell, endcell, clearrange As Range
Sheets("Locations").Select
Sheets("Locations").Range("A1").Select
On Error Resume Next
reallastrow = Cells.Find("*", Range("A1"), xlFormulas, , xlByRows,
xlPrevious).Row
reallastcol = Cells.Find("*", Range("A1"), xlFormulas, ,
xlByColumns, xlPrevious).Column
Set endcell = Cells(reallastrow, reallastcol)
Set startcell = Sheets("Locations").Range("C6")
Set ThecellRange = Range(startcell, endcell)
Set r = ThecellRange
v = r.Value
For i = 1 To UBound(v, 1)
For j = 1 To UBound(v, 2)
If Application.WorksheetFunction.CountIf(r, v(i, j)) > 1 Then
r(i, j).Interior.ColorIndex = 6
Sheets("Locations").Range("A" & Rows.Count).End(xlUp).Offset(1,
0).Value = r(i, j)
Sheets("Locations").Range("B" & Rows.Count).End(xlUp).Offset(1,
0).Value = Application.WorksheetFunction.CountIf(r, v(i, j))
End If
Next j
Next i
End Sub
Cheers
Ste