nick5435
nick5435

Reputation: 53

Transforming Data in Excel

I have data in the format:

NAME_1       : "NAME"
FIELD_1      : BOOL
FIELD_3
FIELD_3
... 
FIELD_40
NAME_2
FIELD_1
...
FIELD_40
...
NAME_276
FIELD_1
... 
FIELD_40

And I would like to transform it into a table with rows based on the NAME_j data with columns based on the FIELD_i values. I've tried using the following macro, but it doesn't do it exactly as I want it to. (The original data is in Sheet1 )

Public Sub toTable()
    Dim rowCountR As Variant
    rowCountR = Worksheets("Sheet1").Range("A1").Rows.Count
    For r = 2 To rowCountR Step 1
    If StrComp(Worksheets("Sheet1").Cells(r, 2).Value, "NAME") = 0 Then
                Worksheets("Sheet2").Cells(Worksheets("Sheet2").Range("A1").Rows.Count, 1).Value = Worksheets("Sheet1").Cells(r, 1).Value
            Else
                For n = 2 To 41 Step 1
                    Worksheets("Sheet2").Cells(r, n).Value = Worksheets("Sheet1").Cells(r, 2)
                Next
            End If
        Next
End Sub

How would I handle this? I'm open to using python or other languges to solving this problem, any ideas are welcome.

Upvotes: 0

Views: 64

Answers (1)

David Zemens
David Zemens

Reputation: 53623

This is kind of brute-forcey, but I think it should work in VBA.

Sub foo()
    Dim dataRange As Range
    Dim r As Range
    Dim i As Long
    Dim myNames As Object
    Dim nm As Variant

    Set myNames = CreateObject("Scripting.Dictionary")

    Set dataRange = Range("A1:B1", Range("A1").End(xlDown))

    ' Collect the key/value pairs, organized by the "Name" field, in to a dict.
    For Each r In dataRange.Rows
        If r.Cells(1).Value Like "Name_*" Then
            ' Add a new entry to our myNames dict
            Set myNames(r.Cells(1).Value) = CreateObject("Scripting.Dictionary")
            nm = r.Cells(1).Offset(0, 1).Value
            myNames(r.Cells(1).Value)("Name") = nm
            ' Put the Field1-Field40 values in the dict as well:
            myNames(r.Cells(1).Value)("FieldValues") = Application.Transpose(r.Cells(1).Offset(1, 1).Resize(40, 1).Value)
        End If
    Next

    ' Write the table header to the sheet
    dataRange.Clear
    Range("A1").Value = "Name"
    For i = 1 To 40
        Range("A1").Offset(0, i).Value = "Field_" & CStr(i)
    Next

    ' Write the original data in to the new table:
    For i = 0 To UBound(myNames.Keys())
        nm = myNames.Keys()(i)

        Range("A2").Offset(i).Value = myNames(nm)("Name")
        Range("A2").Offset(i, 1).Resize(1, 40).Value = myNames(nm)("FieldValues")
    Next
End Sub

Upvotes: 1

Related Questions