How can I best reorder data in mixed row/column format into a simple table?

Question

I have (from a CVS file) data in the following format:

The data is a continued list (row by row of comma separated values) where in arbitrary locations columns are inserted or removed. At these occasions, a new 'header' line is added. The first column is always the date. A straight forward import would look like this:

Now what I would need for further data evaluation is a table like the following:

As I have lots and lots of data in this format, manual rearrangement is not an option.

How can I achieve this resorting automatically?

Either by query-import from the CVS file into Excel, or by subsequent Excel manipulation?

Answer 1

From the point of view of computers and relational database theory, it is much better to transform your mixed data into this form:

This work can be done quite quickly by the following script:

Option Explicit

Sub repackMixedData()
Dim sheet As Worksheet
Dim rSource As Range
Dim rRow As Range
Dim rHeader As Range
Dim oCellDate As Range
Dim oCell As Range
Dim oTargetCell As Range
    Set sheet = ActiveSheet
    Set rSource = sheet.UsedRange
    Set sheet = ThisWorkbook.Worksheets.Add()
    Set oTargetCell = sheet.Range("A1")
    With oTargetCell.Resize(1, 3)
        .Value = Array("Date", "Item", "Value")
        .Font.Bold = True
    End With
    For Each rRow In rSource.Rows
        Set oCellDate = rRow.Cells(1)
        If oCellDate = "Date" Then
            Set rHeader = rRow
        Else
            For Each oCell In rRow.Offset(0, 1).Cells
                If Not IsEmpty(oCell) Then
                    Set oTargetCell = oTargetCell.Offset(1, 0)
                    oTargetCell.Value2 = oCellDate.Value2
                    oTargetCell.NumberFormat = oCellDate.NumberFormat
                    oTargetCell.Offset(0, 1) = rHeader.Cells(1, oCell.Column).Text
                    oTargetCell.Offset(0, 2) = oCell.Value
                End If
            Next oCell
        End If
    Next rRow
End Sub

And with the resulting "flat" table, you can do anything, for example, create a pivot table and get a result similar to your second screenshot.

Update Since it turned out that there is much more real data than expected, the macro has been slightly improved. Please try this option - it should be a bit faster.

Sub repackMixedData2()
Dim sheet As Worksheet
Dim rSource As Range
Dim rRow As Range
Dim rHeader As Range
Dim oCellDate As Range
Dim oCell As Range
Dim countOfValues As Long
Dim arrResult As Variant
Dim index As Long
    Set sheet = ActiveSheet
    Set rSource = sheet.UsedRange
    countOfValues = Application.WorksheetFunction.CountA(rSource.Offset(0, 1))
ReDim arrResult(1 To countOfValues, 1 To 3) As Variant
    index = 1
    arrResult(index, 1) = "Date"
    arrResult(index, 2) = "Item"
    arrResult(index, 3) = "Value"
    For Each rRow In rSource.Rows
        Set oCellDate = rRow.Cells(1)
        If oCellDate = "Date" Then
            Set rHeader = rRow
        Else
            For Each oCell In rRow.Offset(0, 1).Cells
                If IsEmpty(oCell) Then Exit For
                index = index + 1
                arrResult(index, 1) = oCellDate.Value2
                arrResult(index, 2) = rHeader.Cells(1, oCell.Column).Text
                arrResult(index, 3) = oCell.Value
            Next oCell
        End If
    Next rRow
    
    Set sheet = ThisWorkbook.Worksheets.Add()
    sheet.Range("A1:C" & index).Value2 = arrResult
    sheet.Range("A1:C1").Font.Bold = True
    sheet.Range("A:A").NumberFormat = oCellDate.NumberFormat
End Sub