Column2AnString_Unique

Creates list of unique items found in a column, returns string with items separated by sepa
Update: Added small fix to read last item in list

CodeFunctionName

What is this?

Public

Tested

Original Work

Function Column2AnString_Unique(ColumnNam, _
Optional WB = "This", Optional Shee = "Active", Optional Sepa = "||", Optional StartFromRow = 1)
' Create list of items, unique list found in a column
If WB = "This" Then WB = ThisWorkbook.Name
If WB = "Active" Then WB = ActiveWorkbook.Name
If Shee = "Active" Then Shee = Workbooks(WB).Worksheets(1).Name
If ColumnNam = "" Then ColumnNam = "A"
DoEvents
I1 = StartFromRow
I2 = WorksheetFunction.CountA(Workbooks(WB).Worksheets(Shee).Range(ColumnNam & 1).EntireColumn) + 2
Rett = ""
Do Until I1 > I2 + 1
Item1 = Workbooks(WB).Worksheets(Shee).Range(ColumnNam & I1).Value
If IsError(Item1) Then Item1 = Cstr(Item1)
If Item1 = "" Then GoTo NextI1
Found1 = 0
For Each Itt In Split(Rett, Sepa)
If UCase(Itt) = UCase(Item1) Then
Found1 = 1
Exit For
End If
Next
If Found1 = 0 Then
If Rett > "" Then Rett = Rett & Sepa
Rett = Rett & Item1
End If
NextI1:
I1 = I1 + 1
DoEvents
Loop
Column2AnString_Unique = Rett
End Function

ColumnNam, Optional WB = "This", Optional Shee = "Active", Optional Sepa = "||", Optional StartFromRow = 1