[VB] Parsing Excel tabbed data to the object (and vice versa)

[Filyus]

Parsing the data that was copied from Excel.
Data with header is represented as the Collections in the Dictionary.
Data without header is represented as the Collections in the Collection.

Do not forget to add Microsoft Scripting Runtime to the references.

Public Function FromTable(s As String, Optional WithHeader As Boolean = True, _
  Optional Delimiter As String = vbTab) As Object
  Dim TC As Collection, TD As Dictionary, Columns() As Collection
  Dim Rows() As String, Row() As String, Header() As String
  Dim iRow As Long, nRows As Long, iColumn As Long, nColumns As Long, nCurColumns As Long
  If Len(Delimiter) <> 0 Then
    If WithHeader = True Then
      Set TD = New Dictionary
      Rows = Split(s, vbCrLf)
      nRows = UBound(Rows)
      If nRows <> -1 Then
        Header = Split(Rows(0), Delimiter)
        nColumns = UBound(Header)
        ReDim Preserve Columns(nColumns)
        For iColumn = 0 To nColumns
          Set Columns(iColumn) = New Collection
          TD.Add Header(iColumn), Columns(iColumn)
        Next iColumn
        For iRow = 1 To nRows
          Row = Split(Rows(iRow), Delimiter)
          nCurColumns = UBound(Row)
          If nCurColumns > nColumns Then
            nCurColumns = nColumns
          End If
          For iColumn = 0 To nCurColumns
            Columns(iColumn).Add Row(iColumn)
          Next iColumn
          For iColumn = nColumns + 1 To nColumns
            Columns(iColumn).Add vbNullString
          Next iColumn
        Next iRow
        Set FromTable = TD
      End If
    Else
      Set TC = New Collection
      Rows = Split(s, vbCrLf)
      nRows = UBound(Rows)
      If nRows <> -1 Then
        Row = Split(Rows(0), Delimiter)
        nColumns = UBound(Row)
        ReDim Preserve Columns(nColumns)
        For iColumn = 0 To nColumns
          Set Columns(iColumn) = New Collection
          TC.Add Columns(iColumn)
          Columns(iColumn).Add Row(iColumn)
        Next iColumn
        For iRow = 1 To nRows
          Row = Split(Rows(iRow), Delimiter)
          nCurColumns = UBound(Row)
          If nCurColumns > nColumns Then
            nCurColumns = nColumns
          End If
          For iColumn = 0 To nCurColumns
            Columns(iColumn).Add Row(iColumn)
          Next iColumn
          For iColumn = nColumns + 1 To nColumns
            Columns(iColumn).Add vbNullString
          Next iColumn
        Next iRow
        Set FromTable = TC
      End If
    End If
  End If
End Function
 
Public Function IsCollection(a) As Boolean
  If IsObject(a) Then
    If ObjPtr(a) <> 0 Then
      If TypeOf a Is Collection Then
        IsCollection = True
      End If
    End If
  End If
End Function
Public Function ToTable(obj As Object, Optional Delimiter As String = vbTab) As String
  Dim iColumn As Long, nColumns As Long
  Dim iRow As Long, nRows As Long, Items(), Columns() As Collection
  If (Len(Delimiter) <> 0) And IsObject(obj) Then
    If ObjPtr(obj) <> 0 Then
      If TypeOf obj Is Dictionary Then
        nColumns = obj.Count - 1
        If nColumns >= 0 Then
          Items = obj.Items
          ReDim Preserve Columns(nColumns)
          For iColumn = 0 To nColumns
            If IsCollection(Items(iColumn)) = True Then
              Set Columns(iColumn) = Items(iColumn)
            Else
              Exit Function
            End If
          Next iColumn
        End If
      ElseIf TypeOf obj Is Collection Then
        nColumns = obj.Count - 1
        If nColumns >= 0 Then
          ReDim Preserve Columns(nColumns)
          For iColumn = 0 To nColumns
            If IsCollection(obj(iColumn + 1)) Then
              Set Columns(iColumn) = obj(iColumn + 1)
            Else
              Exit Function
            End If
          Next iColumn
        End If
      Else
        Exit Function
      End If
      For iRow = 1 To Columns(0).Count
        For iColumn = 0 To nColumns
          ToTable = ToTable & Columns(iColumn)(iRow)
          If iColumn <> nColumns Then
             ToTable = ToTable & Delimiter
          Else
            ToTable = ToTable & vbCrLf
          End If
        Next iColumn
      Next iRow
    End If
  End If
End Function

[mutley]

Parsing the data that was copied from Excel.
Data with header is represented as the Collections in the Dictionary.
Data without header is represented as the Collections in the Collection.

Do not forget to add Microsoft Scripting Runtime to the references.

Public Function FromTable(s As String, Optional WithHeader As Boolean = True, _
  Optional Delimiter As String = vbTab) As Object
  Dim TC As Collection, TD As Dictionary, Columns() As Collection
  Dim Rows() As String, Row() As String, Header() As String
  Dim iRow As Long, nRows As Long, iColumn As Long, nColumns As Long, nCurColumns As Long
  If Len(Delimiter) <> 0 Then
    If WithHeader = True Then
      Set TD = New Dictionary
      Rows = Split(s, vbCrLf)
      nRows = UBound(Rows)
      If nRows <> -1 Then
        Header = Split(Rows(0), Delimiter)
        nColumns = UBound(Header)
        ReDim Preserve Columns(nColumns)
        For iColumn = 0 To nColumns
          Set Columns(iColumn) = New Collection
          TD.Add Header(iColumn), Columns(iColumn)
        Next iColumn
        For iRow = 1 To nRows
          Row = Split(Rows(iRow), Delimiter)
          nCurColumns = UBound(Row)
          If nCurColumns > nColumns Then
            nCurColumns = nColumns
          End If
          For iColumn = 0 To nCurColumns
            Columns(iColumn).Add Row(iColumn)
          Next iColumn
          For iColumn = nColumns + 1 To nColumns
            Columns(iColumn).Add vbNullString
          Next iColumn
        Next iRow
        Set FromTable = TD
      End If
    Else
      Set TC = New Collection
      Rows = Split(s, vbCrLf)
      nRows = UBound(Rows)
      If nRows <> -1 Then
        Row = Split(Rows(0), Delimiter)
        nColumns = UBound(Row)
        ReDim Preserve Columns(nColumns)
        For iColumn = 0 To nColumns
          Set Columns(iColumn) = New Collection
          TC.Add Columns(iColumn)
          Columns(iColumn).Add Row(iColumn)
        Next iColumn
        For iRow = 1 To nRows
          Row = Split(Rows(iRow), Delimiter)
          nCurColumns = UBound(Row)
          If nCurColumns > nColumns Then
            nCurColumns = nColumns
          End If
          For iColumn = 0 To nCurColumns
            Columns(iColumn).Add Row(iColumn)
          Next iColumn
          For iColumn = nColumns + 1 To nColumns
            Columns(iColumn).Add vbNullString
          Next iColumn
        Next iRow
        Set FromTable = TC
      End If
    End If
  End If
End Function
 
Public Function IsCollection(a) As Boolean
  If IsObject(a) Then
    If ObjPtr(a) <> 0 Then
      If TypeOf a Is Collection Then
        IsCollection = True
      End If
    End If
  End If
End Function
Public Function ToTable(obj As Object, Optional Delimiter As String = vbTab) As String
  Dim iColumn As Long, nColumns As Long
  Dim iRow As Long, nRows As Long, Items(), Columns() As Collection
  If (Len(Delimiter) <> 0) And IsObject(obj) Then
    If ObjPtr(obj) <> 0 Then
      If TypeOf obj Is Dictionary Then
        nColumns = obj.Count - 1
        If nColumns >= 0 Then
          Items = obj.Items
          ReDim Preserve Columns(nColumns)
          For iColumn = 0 To nColumns
            If IsCollection(Items(iColumn)) = True Then
              Set Columns(iColumn) = Items(iColumn)
            Else
              Exit Function
            End If
          Next iColumn
        End If
      ElseIf TypeOf obj Is Collection Then
        nColumns = obj.Count - 1
        If nColumns >= 0 Then
          ReDim Preserve Columns(nColumns)
          For iColumn = 0 To nColumns
            If IsCollection(obj(iColumn + 1)) Then
              Set Columns(iColumn) = obj(iColumn + 1)
            Else
              Exit Function
            End If
          Next iColumn
        End If
      Else
        Exit Function
      End If
      For iRow = 1 To Columns(0).Count
        For iColumn = 0 To nColumns
          ToTable = ToTable & Columns(iColumn)(iRow)
          If iColumn <> nColumns Then
             ToTable = ToTable & Delimiter
          Else
            ToTable = ToTable & vbCrLf
          End If
        Next iColumn
      Next iRow
    End If
  End If
End Function

Hi How to use ?