Option Explicit
Function CountUnique(ListRange As Range) As Integer
Dim CellValue As Variant
Dim UniqueValues As New Collection
Application.Volatile
On Error Resume Next
For Each CellValue In ListRange
UniqueValues.Add CellValue, CStr(CellValue) ' add the unique item
Next
CountUnique = UniqueValues.Count
End Function
Sub howmany()
With Sheet1
If .Range("B2").Value > 1 Then
.Range("C1").Value = CountUnique(Selection)
End If
End With
End Sub
.
Code:Option Explicit Function CountUnique(ListRange As Range) As Integer Dim CellValue As Variant Dim UniqueValues As New Collection Application.Volatile On Error Resume Next For Each CellValue In ListRange UniqueValues.Add CellValue, CStr(CellValue) ' add the unique item Next CountUnique = UniqueValues.Count End Function Sub howmany() With Sheet1 If .Range("B2").Value > 1 Then .Range("C1").Value = CountUnique(Selection) End If End With End Sub