View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Ron Rosenfeld Ron Rosenfeld is offline
external usenet poster
 
Posts: 5,651
Default Counting of Duplicate Values in a column

On Sat, 25 Mar 2006 21:29:33 -0600, tahir
wrote:


Hi Friends,

I m new 2 VBA, i have a sheet that has got a many columns on it, but
the column that is of my interest is, is column A, This column contains
report numbers, I need a way out through some VBA code that could help
me to count how many times a report number has been repeated in that
column. The report numbers are infinite, and keep on growing. at the
moment we r on 5400 reprot no and every day it increases. tomorrow it
might move to 6000 depending on frequency of reprots generated. So my
query is to count that how many times a report number is repeated in
column A.

Regards,


Darno


What, exactly, do you want for output and where do you want to see it?

To get a list of duplicated report numbers and how many times they have been
duplicated, in sorted order, you could use something like the code below. The
output, in this case, is in sorted order and printed in the "immediate window".
But you could output it anyplace.

You also might be able to use the SubTotals or Pivot Table wizards to generate
a report.

==============================
Option Explicit

Sub Dups()
Dim c As Range, a As Range
Dim ReportNum() As Long
Dim ReportCount As Long
Dim i As Long


Set a = [A:A]
Set a = a.Resize(Application.WorksheetFunction.Count(a))
ReDim ReportNum(1 To a.Rows.Count)
For i = 1 To UBound(ReportNum)
ReportNum(i) = a(i).Value
Next i

SingleBubbleSort ReportNum

For i = 1 To UBound(ReportNum)
ReportCount = Application.WorksheetFunction.CountIf(a, ReportNum(i))
If ReportCount 1 Then
Debug.Print "Report Number: " & ReportNum(i) & _
" Count: " & ReportCount
End If
i = i + ReportCount - 1
Next i
End Sub

Sub SingleBubbleSort(TempArray As Variant)
'copied directly from support.microsoft.com
Dim temp As Variant
Dim i As Integer
Dim NoExchanges As Integer

' Loop until no more "exchanges" are made.
Do
NoExchanges = True

' Loop through each element in the array.
For i = 1 To UBound(TempArray) - 1

' If the element is greater than the element
' following it, exchange the two elements.
If TempArray(i) TempArray(i + 1) Then
NoExchanges = False
temp = TempArray(i)
TempArray(i) = TempArray(i + 1)
TempArray(i + 1) = temp
End If
Next i
Loop While Not (NoExchanges)
End Sub
==============================
--ron