Hi M3Cobb

This should do the trick:

Public Sub MyCountIf()
ReDim strNames(0) As String
ReDim intCount(0) As Integer
Dim lngRowLoop As Long
Dim lngRowMax As Long
Dim lngColumn As Long
Dim intFoundLoop As Integer
Dim intFoundMax As Integer
Dim blnNewName As Boolean
Dim strMessage As String

lngColumn = ActiveCell.Column
intFoundMax = -1
For lngRowLoop = ActiveCell.Row To ActiveSheet.UsedRange.Rows.Count
blnNewName = True
If intFoundMax -1 Then
For intFoundLoop = 0 To intFoundMax
If StrComp(strNames(intFoundLoop), Cells(lngRowLoop,
lngColumn).Value, vbTextCompare) = 0 Then
blnNewName = False
intCount(intFoundLoop) = intCount(intFoundLoop) + 1
Exit For
End If
Next
End If
If blnNewName Then
intFoundMax = intFoundMax + 1
If intFoundMax 0 Then
ReDim Preserve strNames(intFoundMax) As String
ReDim Preserve intCount(intFoundMax) As Integer
End If
strNames(intFoundMax) = Cells(lngRowLoop, lngColumn).Value
intCount(intFoundMax) = 1
End If

Next

For intFoundLoop = 0 To intFoundMax
strMessage = strMessage & strNames(intFoundLoop) & vbTab &
intCount(intFoundLoop) & vbNewLine
Next
MsgBox strMessage, vbOKOnly, "My Countif"
End Sub

Select the first cell of the values you want to count and start this
macro

HTH,

Executor

M3Cobb wrote:
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