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.


   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


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.


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

    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
      Exit Sub
   End If
   Set sht = rTop.Parent

   ' create new summary worksheet
   ActiveSheet.Name = sht.Name & " Summary"
   Set sht = ActiveSheet
   Set rTop = sht.Range(rTop.Address)

   ' add header
   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
      Set r = r.Offset(0, 1)
      Application.StatusBar = Application.StatusBar & "."
   Application.ScreenUpdating = True

   ' create PivotTable
   Application.ScreenUpdating = False
   Application.StatusBar = "Creating pivot table..."
   Set r = Range(rTop.Offset(-1), rTop.End(xlDown))
   With ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=r.Address)
      With .CreatePivotTable(TableDestination:=rTop.Offset(-1, 2))
         .AddDataField .PivotFields(FIELDNAME), "Count", xlCount
         .AddFields FIELDNAME, , , True
      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

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.