Reputation: 53
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
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