Hi M3Cobb.

Try:

'=============
Public Sub Tester()
Dim WB As Workbook
Dim SH As Worksheet
Dim myCol As Collection
Dim Arr() As Variant
Dim rCell As Range
Dim rng As Range
Dim i As Long
Dim iLRow As Long
Dim msg As String

Set WB = ThisWorkbook '<<===== CHANGE
Set SH = WB.Sheets("Sheet1") '<<===== CHANGE

iLRow = SH.Cells(Rows.Count, "A").End(xlUp).Row
Set rng = SH.Range("A2:A" & iLRow)

Set myCol = New Collection

For Each rCell In rng.Cells
If Not IsEmpty(rCell.Value) Then
On Error Resume Next
myCol.Add rCell.Value, CStr(rCell.Value)
On Error GoTo 0
End If
Next rCell
On Error Resume Next

ReDim Arr(1 To myCol.Count, 1 To 2)

For i = LBound(Arr, 1) To UBound(Arr, 1)
Arr(i, 1) = myCol.Item(i)
Arr(i, 2) = Application.WorksheetFunction.CountIf(rng, Arr(i, 1))
Next i

For i = LBound(Arr, 1) To UBound(Arr, 1)
msg = msg & Arr(i, 1) & vbTab & Arr(i, 2) & vbNewLine
Next i
On Error GoTo 0
MsgBox msg, , "Unique Values"
End Sub
'<<=============


---
Regards,
Norman



"M3Cobb" wrote in
message ...

I've got a list of data that i frequently refer to.
What i want to do is to have a macro that will do a countif function
and then show the results in a message box:

Apples = 5
pears = 2
oranges = 4

thanks


--
M3Cobb
------------------------------------------------------------------------
M3Cobb's Profile:
http://www.excelforum.com/member.php...o&userid=24986
View this thread: http://www.excelforum.com/showthread...hreadid=550918