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


Public

Tested

My Own 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

Views 370 Downloads 101

VBA-Excel Texts + Strings
ANmarAmdeen
747
Attachments
Revisions

v4.0