How can I transform a list with titles into a tabl

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 'table form' in excel

List form

Department: QUALITY CONTROL  
Worker: DAVID  
Case # 75967  
Case # 75845  
Case # 75949  
Department: PORCELAIN   
Worker: JONATHAN  
Case # 75891  
Case # 75947  
Case # 75962  
Department: SUB-STRUCTURE  
Worker: BILL  
Case # 75997  
Case # 75864  
Case # 75993  

Table form

Any help would be greatly appreciated. I didn't even know what to Google to find out how to do this

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