Hi Howard,

Am Fri, 21 Feb 2014 21:46:36 -0800 (PST) schrieb L. Howard:

Change this

GL14 x
GL15
GL15
GL15
GL16 x
GL17
GL17


to this

GL14 x
GL15 3
GL16 x
GL17 2

try:

Option Explicit
Option Base 1

Sub Test_CB()
Dim LRow As Long
Dim arrIn As Variant
Dim arrOut() As Variant
Dim myArr As Variant
Dim dic As Object
Dim i As Long

LRow = Cells(Rows.Count, 1).End(xlUp).Row
arrIn = Range("A1:B" & LRow)
Set dic = CreateObject("Scripting.Dictionary")

For i = 1 To UBound(arrIn, 1)
dic.item(arrIn(i, 1)) = arrIn(i, 1)
Next

myArr = dic.items
For i = 0 To UBound(myArr)
ReDim Preserve arrOut(dic.Count, 2)
arrOut(i + 1, 1) = myArr(i)
With WorksheetFunction
If .VLookup(myArr(i), Range("A1:B" & LRow), 2, 0) = 0 Then
arrOut(i + 1, 2) = .CountIf(Range("A1:A" & LRow), myArr(i))
Else
arrOut(i + 1, 2) = .VLookup(myArr(i), Range("A1:B" & LRow),
2, 0)
End If
End With
Next
Range("C1").Resize(dic.Count, 2) = arrOut
End Sub

The code will give you unique values and the number of these values in
column C:D


Regards
Claus B.
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2