Try the below with data in Sheet1 Col A...the unique list summary will be
generated in Sheet2. Test and feedback


Sub Button1_Click()

Dim lngRow As Long, lngLastRow As Long
Dim ws1 As Worksheet, ws2 As Worksheet

Set ws1 = ActiveSheet
Set ws2 = Sheets("Sheet2")

lngLastRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
ws1.Range("A1:A" & lngLastRow).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=ws2.Range("A1"), Unique:=True
ws2.Range("B1") = "Total"
For lngRow = 2 To ws2.Cells(Rows.Count, "A").End(xlUp).Row
ws2.Range("B" & lngRow) = WorksheetFunction.CountIf(ws1.Range("A1:A" & _
lngLastRow), ws2.Range("A" & lngRow))
Next

End Sub

If this post helps click Yes
---------------
Jacob Skaria


"Maarten V." wrote:

so i have the folowing code:

Sub Button1_Click()

Dim lngRow As Long, lngLastRow As Long
lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A1:A" & lngLastRow).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("'Sheet2'!A1"), Unique:=True
Range("'Sheet2'!B1") = "Total"
For lngRow = 2 To Cells(Rows.Count, "C").End(xlUp).Row
Range("'Sheet2'!B" & lngRow) = WorksheetFunction.CountIf(Range("A1:A" & _
lngLastRow), Range("'Sheet2'!A" & lngRow))
Next



End Sub

and i can't fix this line:
For lngRow = 2 To Cells(Rows.Count, "C").End(xlUp).Row

to

For lngRow = 2 To Cells(Rows.Count, "'Sheet2'! A").End(xlUp).Row

any input?

"Maarten V." wrote:

hi thx,

srry but i am realy new in this
How can i write the new information to a new worksheet or file?
with the macro code.


"Jacob Skaria" wrote:

----You can use Autofilter and COUNTIF() to acheive this
1. Select the range in Col A including the header. You need to have headers
for this column
2. From menu DataFilterAdvanced FilterCopy to another location
3. In copy to I have selected C1 and check 'Unique records only'
4. Click OK will give you the unique list in ColC
6. In D2 apply the below formula

=COUNTIF(A:A,C2)
Copy the formula down as required


---If you are looking for a macro place your data in ColA and assign a
header in cell A1. Try the below macro

Sub Macro1()
Dim lngRow As Long, lngLastRow As Long
lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A1:A" & lngLastRow).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("C1"), Unique:=True
Range("D1") = "Total"
For lngRow = 2 To Cells(Rows.Count, "C").End(xlUp).Row
Range("D" & lngRow) = WorksheetFunction.CountIf(Range("A1:A" & _
lngLastRow), Range("C" & lngRow))
Next
End Sub


If this post helps click Yes
---------------
Jacob Skaria


"Maarten V." wrote:

i'am getting from an other program a *.txt with data.
something like this:

apple
apple
apple
orange
apple
orange

I need to count how many of each kind there are, so :
apple 4
orange 2
apple
apple
orange
apple

and now i have to delete to other rows, so at the end i have only this:
apple 4
orange 2

how can i do this?