The VBA script below looks for all unique values from cell B5 all the way down to the very last cell in column B… $B$1048576. Once it is found, they are stored in the array (objDict).

Note that, this script also keeps track of the number of unique values. (.Count).

One word of caution is that you need to have the sheet in question in focus using the following statement before executing the “Application.Transpose…..” command.

Sheets(SHT_MASTER).Activate

If the sheet is not active, you will get the following error when you run the VBA script (Application-defined or object-defined error).

Without further ado, here is the source code.

Option Explicit

Private Const SHT_MASTER = “MASTER”
Private Const SHT_INST_INDEX = “InstrumentIndex”

Sub UniqueList()
Dim Xyber
Dim objDict As Object
Dim lngRow As Long

Sheets(SHT_MASTER).Activate
Xyber = Application.Transpose(Sheets(SHT_MASTER).Range([b5], Cells(Rows.count, “B”).End(xlUp)))
Sheets(SHT_INST_INDEX).Activate
Set objDict = CreateObject(“Scripting.Dictionary”)
For lngRow = 1 To UBound(Xyber, 1)
If Len(Xyber(lngRow)) > 0 Then objDict(Xyber(lngRow)) = 1
Next
Sheets(SHT_INST_INDEX).Range(“B1:B” & objDict.count) = Application.Transpose(objDict.keys)
End Sub