PDA

View Full Version : Counting variants in Range



bassman71
09-16-2006, 06:18 PM
Hello,

The following code works fine, but am wondering if there is a built-in function or better way of counting the disparate pieces of data in a range. In this example(range column pre-sorted) I loop through the range and adding one to counter with each iteration until the next cell is different from current cell. Then the value of the counter along with the cell value is placed in an unused portion of sheet(which incidentally is also subjected to count property)

Thanks.........


Dim i As Variant, rng As Range, counter As Integer, cntr2 As Integer
i = InputBox("Enter Column Letter corresponding with field to be evaluated for Chart")

'This sets location for the counted variants in range
Range("A65536").Select
ActiveCell.End(xlUp).Select
Set rng = Range(ActiveCell(3, 1).Address)
rng = Range(i & "1").Value
rng(1, 2).Value = "Unresolved Issues"
Range(rng, rng(1, 2)).Select
Selection.Font.Bold = True
Range(i & "2").Select

counter = 0
cntr2 = 2
Do
Do

If ActiveCell.Value = ActiveCell(2, 1).Value Then
ActiveCell.Offset(1, 0).Select
counter = counter + 1
End If
Loop Until ActiveCell(2, 1).Value <> ActiveCell.Value

rng(cntr2, 2) = counter + 1
rng(cntr2, 1) = ActiveCell.Value
counter = 0
cntr2 = cntr2 + 1
ActiveCell.Offset(1, 0).Select
Loop Until ActiveCell.Value = ""
:dunno

mdmackillop
09-16-2006, 06:31 PM
Is this any help?
http://vbaexpress.com/kb/getarticle.php?kb_id=705

mdmackillop
09-16-2006, 06:52 PM
This is a bit shorter, but seems to need a header to the data column included in the selection

Sub Macro1()
Selection.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=ActiveCell.Offset(, 2), Unique:=True
ActiveCell.Offset(1, 3) = "=COUNTIF(C[-3],RC[-1])"
ActiveCell.Offset(1, 3).AutoFill Destination:=Range(ActiveCell.Offset(1, 2), _
ActiveCell.Offset(1, 2).End(xlDown)).Offset(, 1)
End Sub

Bob Phillips
09-17-2006, 02:32 AM
Can be done in one hit



Sub Macro1()
With ActiveCell
Selection.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=.Offset(, 2), _
Unique:=True
.Offset(1, 3).Resize(.Offset(1, 2).End(xlDown).Row - 1) = "=COUNTIF(C[-3],RC[-1])"
End With
End Sub

mdmackillop
09-17-2006, 04:54 AM
Much neater :thumb

bassman71
09-17-2006, 07:35 PM
Thanks much!