# Unique string values in range

I have some spreadsheets where there are large number of cells that have essentially been used for free text.

There is a finite set of values for this free text and most, if not all repeat.

eg.

``````   A        B       C       D
1  Monkey   Gorilla Cat     Dog
2  Dog      Cat     Gorilla Gorilla
3  Dog      Dog     Dog     Cat
``````

There are probably 50 or so different cell values spread over multiple sheets and hundreds of rows and columns.

I need to analyse this data and count occurancies, which is not a problem other than getting a list of unique values to start with and this has been driving me up the wall.

What is the best way to produce this list.

So from the above we would have

``````Monkey
Dog
Cat
Gorilla
``````

In order of preferred solutions, as this will need to be done monthly.

1. Dynamic formula based
2. VB Script
3. Other ( Advanced filtering or other manual steps )
-
I have solved this by exporting to csv and writing a ruby script, however others may find any answers helpful. I will ensure any answers are reviewed. – Dean Smith Mar 21 '12 at 16:50

Based on some starting code found here, this USER DEFINED FUNCTION will collect all the values from all the cells on all OTHER sheets than the one you use this function on. So be clear, insert a blank sheet into your workbook and use this function on that sheet only.

=UNIQUE(ROW(A1))

Put that formula in any cell, then copy down until no more values appear.

In that same workbook, put this UDF code into a blank module (Insert > Module):

``````    Option Explicit

Function UNIQUE(ItemNo As Long) As Variant
Dim cl As Range, cUnique As New Collection, cValue As Variant
Dim ws As Worksheet, Inputrange As Range
Application.Volatile

On Error Resume Next
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> Application.Caller.Parent.Name Then
For Each cl In ws.UsedRange
If cl.Formula <> "" Then cUnique.Add cl.Value, CStr(cl.Value)
Next cl
End If
Next ws
On Error GoTo 0

UNIQUE = ""
If ItemNo = 0 Then
UNIQUE = cUnique.Count
ElseIf ItemNo <= cUnique.Count Then
UNIQUE = cUnique(ItemNo)
End If

End Function
``````
-

Assuming the data is small enough to fit in one column on a worksheet, I'd copy all columns into one column and create a simple pivot table to count each value for me.

To run it frequently, I'd create a VBA Macro, not a VB Script. The below procedure will do the whole thing automatically in Excel 2010. (Some of the pivot table code might be different in earlier versions of Excel.)

``````Sub CreateSummary()
' This macro assumes there is nothing else below the data being summarized
' and that there are no empty cells in any of the columns of data.
Const FIELDNAME As String = "FreeText"
Dim v As Variant
Dim sht As Worksheet, rTop As Range, r As Range
Dim pc As PivotCache, pt As PivotTable

Set v = Application.InputBox("Select first cell of table to be summarized." _
, "Create Summary", Type:=8)
If TypeName(v) = "Range" Then
Set rTop = v
Else
Exit Sub
End If
Set sht = rTop.Parent

' create new summary worksheet
sht.Copy
ActiveSheet.Name = sht.Name & " Summary"
Set sht = ActiveSheet

rTop.Rows.EntireRow.Insert
With rTop.Offset(-1)
.Value = FIELDNAME
.Font.Bold = True
.BorderAround XlLineStyle.xlContinuous
End With

' Grab data from other columns and move it to first column
Application.ScreenUpdating = False
Application.StatusBar = "Converting table to one column ..."
Set r = rTop.Offset(0, 1)
Do While r.Value <> ""
sht.Range(r, r.SpecialCells(xlCellTypeLastCell)).Cut
rTop.End(xlDown).Offset(1).Select
sht.Paste
Set r = r.Offset(0, 1)
Application.StatusBar = Application.StatusBar & "."
DoEvents
Loop
rTop.Select
Application.ScreenUpdating = True

' create PivotTable
Application.ScreenUpdating = False
Application.StatusBar = "Creating pivot table..."
Set r = Range(rTop.Offset(-1), rTop.End(xlDown))
With .CreatePivotTable(TableDestination:=rTop.Offset(-1, 2))
End With
End With
Application.ScreenUpdating = True
Application.StatusBar = False

Set r = Nothing
Set rTop = Nothing
Set sht = Nothing

MsgBox "Done creating summary."
End Sub
``````
-