How can I transform a list with titles into a table

Question

Is there a way to get automatically transform the data from the \'list form\' into the \'table form\' other than doing it manually?

In the end I am wanting to use the \'

Answer 1

EDITED - See below first piece of code I think this would work for you. The original list is supposed to be in "Sheet1", ordered data is written to "Sheet2". I'm using arrays (sData and sData2) for storing temporal data.

Dim lLastRow As Long
Dim i As Integer
Dim k As Integer
Dim sData() As String
Dim sData2(0 To 2) As String

Private Sub ListToTable()
    'get number of rows with data
    lLastRow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    k = 2 'destination table will start in line 2 (line 1 for titles).
    'Set titles in destination sheet
    Worksheets("Sheet2").Cells(1, 1).Value = "Depertment"
    Worksheets("Sheet2").Cells(1, 1).Font.Bold = True
    Worksheets("Sheet2").Cells(1, 2).Value = "Worker"
    Worksheets("Sheet2").Cells(1, 2).Font.Bold = True
    Worksheets("Sheet2").Cells(1, 3).Value = "Case"
    Worksheets("Sheet2").Cells(1, 3).Font.Bold = True


    For i = 1 To lLastRow
        'split the data using ":" as delimiter
        sData = Split(Worksheets("Sheet1").Cells(i, 1), ":")

        If sData(0) = "Department" Then
            sData2(0) = Trim(sData(1)) 'Trim just for eliminating spaces
        ElseIf sData(0) = "Worker" Then
            sData2(1) = Trim(sData(1))
        Else
            sData2(2) = Trim(sData(0))
            Worksheets("Sheet2").Cells(k, 1).Value = sData2(0)
            Worksheets("Sheet2").Cells(k, 2).Value = sData2(1)
            Worksheets("Sheet2").Cells(k, 3).Value = sData2(2)
            k = k + 1
        End If

    Next i
End Sub

UPDATE according to comment In your comments you ask for a second list-to-table transformation. Basically you first need to differentiate between the "two things" in your list. This depends on your data. I choose to check is the first two (Left) characters in the cells is a number or not (IsNumeric). Then the code is very similar to the one above here. When defining the variables on top add Dim sFirstColumn as String and Dim iSecondColumn as Integer (or whatever according to your data).

For i = 1 To lLastRow
    If Not IsNumeric(Left(Worksheets("Sheet1").Cells(i, 1), 2)) Then
        sFirstColumn = Worksheets("Sheet1").Cells(i, 1).Value
    Else
        iSecondColumn = Worksheets("Sheet1").Cells(i, 1).Value

        Worksheets("Sheet2").Cells(k, 1).Value = sFirstColumn
        Worksheets("Sheet2").Cells(k, 2).Value = iSecondColumn
        k = k + 1
    End If
Next i