# Frequency of items in a huge range

C

#### Charles Fish

I have a huge range A1:FZ139
Cells contain assorted text, and many cells are blank.
Many text values are duplicated.
How can I create a list of unique text values and the frequency of each?

for example:

the 512
fish 12
wish 8

Thanks much!
Charles

C

#### Claus Busch

Hi Charles,

Am Tue, 21 Oct 2014 10:10:02 -0700 (PDT) schrieb Charles Fish:
I have a huge range A1:FZ139
Cells contain assorted text, and many cells are blank.
Many text values are duplicated.
How can I create a list of unique text values and the frequency of each?

your data in Sheet1. Then the code will write you a unique list with the
count of each item to Sheet2:

Sub Test()
Dim myDic As Object
Dim varTmp As Variant
Dim varData As Variant, varOut() As Variant
Dim i As Long, j As Long, n As Long
Dim myRng As Range

Set myRng = Sheets("Sheet1").Range("A1:FZ139")
varTmp = myRng
Set myDic = CreateObject("Scripting.Dictionary")
For i = 1 To 139
For j = 1 To 182
myDic(varTmp(i, j)) = varTmp(i, j)
Next
Next
varData = myDic.items
For i = LBound(varData) To UBound(varData)
ReDim Preserve varOut(UBound(varData), 1)
If varData(i) <> "" Then
varOut(n, 0) = varData(i)
varOut(n, 1) = WorksheetFunction.CountIf(myRng, varData(i))
n = n + 1
End If
Next
Sheets("Sheet2").Range("A1").Resize(UBound(varOut), 2) = varOut
End Sub

Regards
Claus B.

C

#### Claus Busch

Hi Charles,

Am Tue, 21 Oct 2014 19:33:42 +0200 schrieb Claus Busch:
Sheets("Sheet2").Range("A1").Resize(UBound(varOut), 2) = varOut
End Sub

there is a typo in the line above. Change it to:
Sheets("Sheet2").Range("A1").Resize(UBound(varOut) + 1, 2) = varOut

Regards
Claus B.

C

#### Charles Fish

I have a huge range A1:FZ139

Cells contain assorted text, and many cells are blank.

Many text values are duplicated.

How can I create a list of unique text values and the frequency of each?

for example:

the 512

fish 12

wish 8

Thanks much!

Charles

Thank you Claus!