Collection2CSV()

This is JOIN() for more than just one-dimensional arrays of strings. This example illustrations what I mean:

Debug.Print Collection2CSV(ActiveWorkbook.Worksheets)

This one routine does a lot. And when I need it to handle something different, I just add what I need so I can have just one way to deal with things like this. And I have to deal with things like this very often. Here is the function

Public Function Collection2CSV(ByVal vCollection As Variant, _

Optional ByVal bSort As Boolean = True, _

Optional ByVal vWorkbook As Variant) As String

' Description:Create a CSV (comma seperated values) string from a collection

' Inputs: vCollection Collection to convert items to a CSV

' bSort Sort collection first

' vWorkbook Workbook containing collections

' Outputs: Collection2CSV If Success: CSV string

' If Failure: ""

' Requisites: Routines modGeneral.Exists()

' modGeneral.HasQueryTable()

' modGeneral.IsArrayAllocated

' modGeneral.Tables

' Example: ?Collection2CSV("Tables")

' ?Collection2CSV(Thisworkbook.BuiltinDocumentProperties)

' Date Ini Modification

' 08/14/11 CWH Initial Development

' 12/03/11 CWH Removed Worksheet

' 03/10/12 CWH Added QueryTables

' 03/26/12 CWH Accommodated Embedded Charts

' 04/12/12 CWH Separated this from CBO_Fill

' 09/08/12 CWH Replace obj with v and added Variant()

' 11/28/12 CWH Version 2013.01

' 01/22/13 CWH Used DisplayName for tables

' 07/22/13 CWH Handled empty collection

' 09/17/13 CWH Added oWkb parameter

' 09/18/13 CWH > 0

' 03/16/15 CWH Added Dictionary

' 05/12/15 CWH Added ListRow, ListColumn

' 05/04/18 CWH Handled vWorkbook = Nothing

' 08/14/19 CWH Added FileDialogSelectedItems

' 01/25/21 CWH Handed cells with errors in Case is = "Range"

' Declarations

Const cRoutine As String = "Collection2CSV"

Dim oWkb As Workbook 'Current Workbook

Dim oWks As Worksheet 'Current Worksheet

Dim oLo As ListObject 'Current ListObject

Dim sCSV As String 'Temporary Result

Dim v As Variant 'Element of collection/list/array/range...

Dim i As Integer 'Generic Counter

Dim s As String 'Generic String

' Error Handling and Function initialization

On Error GoTo ErrHandler

Collection2CSV = ""

' Check Inputs

If IsMissing(vWorkbook) Then Set vWorkbook = ActiveWorkbook

If vWorkbook Is Nothing Then Set vWorkbook = ThisWorkbook

Set oWkb = vWorkbook

' Procedure

Select Case TypeName(vCollection)

Case Is = "Nothing"

sCSV = vbNullString

Case Is = "Range":

For Each v In vCollection.Cells

sCSV = IIf(Len(sCSV) > 0, sCSV & ",", "") & v.Text

For Each v In vCollection.ListRows

sCSV = IIf(Len(sCSV) > 0, sCSV & ",", "") & v.Range(1)

For Each v In vCollection.Keys()

sCSV = IIf(Len(sCSV) > 0, sCSV & ",", "") & CStr(v)

Select Case UCase(Trim(vCollection))

Case Is = "CHARTS"

For Each v In oWkb.Charts

sCSV = IIf(Len(sCSV) > 0, sCSV & ",", "") & v.Name

For Each v In oWks.ChartObjects

sCSV = IIf(Len(sCSV) > 1, sCSV & ",", "") & _

oWks.Name & ":" & v.Index

Case Is = "NAMES"

For Each v In oWkb.Names

sCSV = IIf(Len(sCSV) > 0, sCSV & ",", "") & v.Name

For Each oWks In oWkb.Worksheets

For Each v In oWks.PivotTables

sCSV = IIf(Len(sCSV) > 0, sCSV & ",", "") & v.Name

Case Is = "QUERYTABLES"

For Each oWks In oWkb.Worksheets

For Each v In oWks.ListObjects

If HasQueryTable(v) Then _

sCSV = IIf(Len(sCSV) > 0, sCSV & ",", "") & v.DisplayName

Case Is = "SHAPES"

For Each oWks In oWkb.Worksheets

For Each v In oWks.Shapes

sCSV = IIf(Len(sCSV) > 0, sCSV & ",", "") & v.Name

Case Is = "STYLES"

For Each v In oWkb.Styles

sCSV = IIf(Len(sCSV) > 0, sCSV & ",", "") & v.Name

For Each v In oWkb.TableStyles

If v.Name Like "Pivot*" Then _

sCSV = IIf(Len(sCSV) > 0, sCSV & ",", "") & v.Name

For Each v In oWkb.TableStyles

If Not v.Name Like "Pivot*" Then _

sCSV = IIf(Len(sCSV) > 0, sCSV & ",", "") & v.Name

For Each oWks In oWkb.Worksheets

For Each v In oWks.ListObjects

sCSV = IIf(Len(sCSV) > 0, sCSV & ",", "") & v.DisplayName

Case Is = "TABLES AND NAMES"

For Each oWks In oWkb.Worksheets

For Each v In oWks.ListObjects

sCSV = IIf(Len(sCSV) > 0, sCSV & ",", "") & v.DisplayName

For Each v In oWkb.Names

If v.Visible Then _

sCSV = IIf(Len(sCSV) > 0, sCSV & ",", "") & v.Name

For Each v In Application.Workbooks

sCSV = IIf(Len(sCSV) > 0, sCSV & ",", "") & v.Name

For Each v In oWkb.Worksheets

sCSV = IIf(Len(sCSV) > 0, sCSV & ",", "") & v.Name

If CStr(vCollection) = "" Then

sCSV = vCollection

ElseIf Exists(Tables, CStr(vCollection), oLo) Then

sCSV = Collection2CSV(oLo)

ElseIf Not cRange(vCollection) Is Nothing Then

sCSV = Collection2CSV(cRange(vCollection).Columns(1))

Else

sCSV = vCollection

End If

End Select

Case Else

If IsArray(vCollection) Then

If IsArrayAllocated(vCollection) Then

For Each v In vCollection

Select Case TypeName(v)

Case Is = "Range": v = v.Text

Case Is = "Object": v = v.Name

Case Else

End Select

sCSV = IIf(Len(sCSV) > 0, sCSV & ",", "") & v

ElseIf IsObject(vCollection) Then

Select Case TypeName(vCollection)

Case Is = "ListColumn", "ListRow"

For Each v In vCollection.Range.Cells

sCSV = IIf(Len(sCSV) > 0, sCSV & ",", "") & v

For Each v In vCollection

sCSV = IIf(Len(sCSV) > 0, sCSV & ",", "") & v.InnerText

For Each v In vCollection

sCSV = IIf(Len(sCSV) > 0, sCSV & ",", "") & v

For Each v In vCollection

sCSV = IIf(Len(sCSV) > 0, sCSV & ",", "") & v.Name

End If

End Select

If bSort And UBound(Split(sCSV, ",")) > 0 Then _

sCSV = Collection2CSV(Sort(Split(sCSV, ",")), False)

Collection2CSV = sCSV

ErrHandler:

Select Case Err.Number

Case Is = NoError: 'Do nothing

Case Else:

Select Case DspErrMsg(cModule & "." & cRoutine)

Case Is = vbAbort: Stop: Resume 'Debug mode - Trace

Case Is = vbRetry: Resume 'Try again

Case Is = vbIgnore: 'End routine

End Select

End Function

References:
DspErrMsg()
Exists()
HasQueryTable()
IsArrayAllocated()
Tables()