Counting variants in Range

[bassman71]

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 = ""

[mdmackillop]

Is this any help?
http://vbaexpress.com/kb/getarticle.php?kb_id=705

[mdmackillop]

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).AutoFill Destination:=Range(ActiveCell.Offset(1, 2), _
    ActiveCell.Offset(1, 2).End(xlDown)).Offset(, 1)
End Sub

[Bob Phillips]

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]

Much neater

[bassman71]

Thanks much!