Is there a faster/better way to accomplish scan of a range for unique text values/save those unique values to range, sort alphabetically?

[johnnyL]

Book1.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U
1
2
3			Red	14	6		Green	8	3		Blue	1	3		Brown	4	10		Black	2	5
4			Blue	2	1		Purple	2	7		Red	4	2						Green	6	1
5			Green	5	2		Orange	6	1										Orange	4	7
6							Red	0	5										Purple	8	3
7							Yellow	4	9
8							Black	12	13
Sheet1

Back to this file ...

I want to capture unique text values from a range, sort that range, into the A column, and possibly even count the occurrences of each unique text value found into the corresponding B column.

The following is the code that I have came up with thus far ...

Sub Find_PrintUniqueNonNumericTextFoundInSelectedRangeToRangeAndSortFoundTextAlphabetically()    ' Works
    Dim DataFoundInCell As Range, r As Range, x0
'
'   \/ Variables to set \/
    SortRange1stCellAddress = "C3"
    SortRangeLastCellAddress = "U8"
'
    With CreateObject("scripting.dictionary")
        For Each DataFoundInCell In ActiveSheet.Range(SortRange1stCellAddress & ":" & SortRangeLastCellAddress).SpecialCells(2)
            If Not IsNumeric(DataFoundInCell) Then x0 = .Item(DataFoundInCell.Value)      '
        Next
'
        Set r = Cells(1, "A").Resize(.Count, 1)                 '
'
        r.Value = Application.Transpose(.Keys)                  '
    End With
'
'   Sort Column A, that now contains the unique text values, alphabetically
'   \/ Variables to set \/
    SortRange1stCellAddress = "A1"
    SheetName = "Sheet1"
'
    SortRangeLastCellAddress = Range(SortRange1stCellAddress).End(xlDown).Address(0, 0)     '
'
    ActiveWorkbook.Worksheets(SheetName).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(SheetName).Sort.SortFields.Add Key:=Range(SortRange1stCellAddress), Order:=xlAscending    ' Predominant sort starting address
'
    With ActiveWorkbook.Worksheets(SheetName).Sort
        .SetRange Range(SortRange1stCellAddress & ":" & SortRangeLastCellAddress)
        .Header = xlNo
        .Apply
    End With
End Sub

 

[Fluff]

Why/How does the '1' at the end of the line equate to the counter?

It's the first time that value exists so it's count is one.

 

[johnnyL]

It's the first time that value exists so it's count is one.

???