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

From my point of view using Pivot Table is the best method in this
case.

Excel 2003:-
Select the data and press Alt+D+P>>Click Next>>Now your data will be
getting selected with marching ants>>Click Next Once again>>Click
Layout>> In the left side of the layout window the column headers will
be shown
Just drag the heading Number in Row Field and Occurrences in Data
Field. Do double click in Occurrences Field from Data and select
Count and Give Ok Twice. Select the destination of your report and
click finish.


Excel 2007:-
Select the data and press Alt+D+P>>Click Next>>Now your data will be
getting selected with marching ants>>Click Next Once again>> Select
the destination of your report and click finish

Just drag the heading Number in Row Labels and Occurrences in Values
Field. Click on Occurrences Field from Values and select “Value Field
Settings” and select count and give ok.

Hope it’s clear to you!

-----------------------
Ms-Exl-Learner
-----------------------


On Jul 20, 1:36*pm, Ste Mac <ste...@gmail.com> wrote:
> 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

Hi Ms-Exl-Learner, thanks for your help... its just that this piece of
code is only one of many operations....

What i am really after is this piece of code just giving the
'Duplicate' values and
how many of them there are...

Cheers

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

I don’t know abc about the VBA code and that’s also one of the reason
for suggesting Pivot Table, Otherwise I might have provided the VBA
code to you.

-----------------------
Ms-Exl-Learner
-----------------------


On Jul 20, 2:49*pm, Ste Mac <ste...@gmail.com> wrote:
> Hi Ms-Exl-Learner, thanks for your help... its just that this piece of
> code is only one of many operations....
>
> What i am really after is this piece of code just giving the
> 'Duplicate' values and
> how many of them there are...
>
> Cheers
>
> 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

Ste Mac formulated the question :
> 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

One possible solution would be to store each value in a delimited
string if not already there in that string, and only process unique
values.

Example: <air code>
Dim sUniVals As String, lDupes As Long
v = r.Value
For i = 1 To UBound(v, 1)
For j = 1 To UBound(v, 2)
lDupes = Application.WorksheetFunction.CountIf(r, v(i, j))
If lDupes > 1 Then
r(i, j).Interior.ColorIndex = 6
If Not InStr$(sUniVals, CStr(v(i))) > 0 Then
'Add it to the list of unique values and process it
sUniVals = sUniVals & CStr(v(i)) & ","
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 = lDupes
End If 'Not InStr$(sUniVals, CStr(v(i))) > 0
End If 'Application.WorksheetFunction.CountIf(r, v(i, j)) > 1
Next j
Next i

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Oops! The last 'End If' should be:

End If 'lDupes > 1

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Hi Garry, sorry for the late reply (just got home from work)

Thanks for your suggestion, I pasted the code into the macro and it
runs fine..
Except, once again it gives me the correct count of duplicates but
puts each
'Duplicate' found in column 'A' as many time as the duplicate is in
the range.

i.e - it found 6621 four times, so it wrote

Number Occurences
6621 4
6621 4
6621 4
6621 4

How can I stop it doing this? so the data would look like~:
Number Occurences
6621 4
6629 2
1295 3

Thanks for any suggestions...

Ste

Ste Mac brought next idea :
> Hi Garry, sorry for the late reply (just got home from work)
>
> Thanks for your suggestion, I pasted the code into the macro and it
> runs fine..
> Except, once again it gives me the correct count of duplicates but
> puts each
> 'Duplicate' found in column 'A' as many time as the duplicate is in
> the range.
>
> i.e - it found 6621 four times, so it wrote
>
> Number Occurences
> 6621 4
> 6621 4
> 6621 4
> 6621 4
>
> How can I stop it doing this? so the data would look like~:
> Number Occurences
> 6621 4
> 6629 2
> 1295 3
>
> Thanks for any suggestions...
>
> Ste

Try changing the line that tests if the value has already been
processed to:
If Not InStr$(sUniVals, CStr(v(i, 1))) > 0 Then

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Cheers Garry...

sorry for the late reply (work is getting in the way : ))

I will give it a whirl and will let you know...

cheers

ste