Sub UniqueValues()
Dim ws As Worksheet
Dim uniqueRng As Range
Dim myCol As Long
myCol = 2
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set uniqueRng = GetUniqueValues(ws, myCol)
End Sub
Function GetUniqueValues(ws As Worksheet, col As Long) As Range
Dim firstRow As Long
With ws
.Columns(col).RemoveDuplicates Columns:=Array(1), Header:=xlNo
firstRow = 1
If IsEmpty(.Cells(1, col)) Then firstRow = .Cells(1, col).End(xlDown).Row
Set GetUniqueValues = Range(.Cells(firstRow, col), .Cells(.Rows.Count, col).End(xlUp))
End With
End Function
Thanks Rahul!hii,
please find the attached solution using pivot tabel .it is very easy and fast with out using long formula
thanks
rahul shewale
You can also try to use Pivot Table. Instead of "SUM" which will come as default, choose "COUNT". See attached file for your reference (had to delete few rows as it was too big for upload).
Thanks a LOTT!!
No Monty, it does not work. I tried it in Macro. It does not do it. You can try it yourself.May be this to try with macro
Code:Sub UniqueValues() Dim ws As Worksheet Dim uniqueRng As Range Dim myCol As Long myCol = 2 Set ws = ThisWorkbook.Worksheets("Sheet1") Set uniqueRng = GetUniqueValues(ws, myCol) End Sub Function GetUniqueValues(ws As Worksheet, col As Long) As Range Dim firstRow As Long With ws .Columns(col).RemoveDuplicates Columns:=Array(1), Header:=xlNo firstRow = 1 If IsEmpty(.Cells(1, col)) Then firstRow = .Cells(1, col).End(xlDown).Row Set GetUniqueValues = Range(.Cells(firstRow, col), .Cells(.Rows.Count, col).End(xlUp)) End With End Function