Skip to content

Instantly share code, notes, and snippets.

What would you like to do?
This script prompts the user to select a range, then puts all the unique values from that range into a single column list on a new worksheet
Public Sub WriteUniquesToNewSheet()
Dim wksUniques As Worksheet
Dim rngUniques As Range, rngTarget As Range
Dim strPrompt As String
Dim varUniques As Variant
Dim lngIdx As Long
Dim colUniques As Collection
Set colUniques = New Collection
'Prompt the user to select a range to unique-ify
strPrompt = "Select the Range from which you'd like to extract uniques"
On Error Resume Next
Set rngTarget = Application.InputBox(strPrompt, "Get Range", Type:=8)
On Error GoTo 0
If rngTarget Is Nothing Then Exit Sub '<~ in case the user clicks Cancel
'Collect the uniques using the function we just wrote
Set colUniques = CollectUniques(rngTarget)
'Load a Variant array with the uniques
'(in preparation for writing them to a new sheet)
ReDim varUniques(colUniques.Count, 1)
For lngIdx = 1 To colUniques.Count
varUniques(lngIdx - 1, 0) = CStr(colUniques(lngIdx))
Next lngIdx
'Create a new worksheet (where we will store our uniques)
Set wksUniques = ThisWorkbook.Worksheets.Add
Set rngUniques = wksUniques.Range("A1:A" & colUniques.Count)
rngUniques = varUniques
'Let the user know we're done!
MsgBox "Finished!"
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment