Dynamically reformatting an excel sheet - excel

Question

I have a very messy excel sheet that I'm trying to reformat into something readable. Currently, it is structured as such (each large separation resembles a new cell):
Title1 Var1 Var1_Value Var1.1 Var1.1_Value ... Var1.K Var1.K_Value
Title2 Var2 Var2_Value Var2.1 Var2.1_Value ... Var2.L Var2.L_Value
...
TitleM VarM VarM_Value VarM.1 VarM.1_Value ... VarM.N VarM.N_Value
To clarify, the amount of variables and values per column varies for each row, however every variable will have a value. Ultimately, my end goal is to create something formatted as such:
Title1 Var1 Var1_Value
Title1 Var1.1 Var1.1_Value
...
TitleM VarM.N VarM.N_Value
Where the Title string is repeated for each Var and Var_Value in its row.
I don't know a lot about VBA, so I'm looking for help on the best avenue to achieve this formatting. Here is my thought process in psuedocode below, I tried to format to be VBA-esque when I could.
for idx = 1 To lastRow
' Will likely have to create a function to find
' last filled column in a row -- lastColForRow
tempArray = data(idx,2 To lastColforRow(idx))
for jdx = 1 To length(tempArray)-1 Step 2
newCell(end+1,1) = data(idx,1)
newCell(end+1,2) = tempArray(j)
newCell(end+1,3) = tempArray(j+1)
next jdx
next idx

Answer 1

This code should do it (note that it assumes that there is no header row)
Public Sub Reformat()
Dim lastrow As Long
Dim lastcol As Long
Dim numrows As Long
Dim i As Long, ii As Long
Application.ScreenUpdating = False
With ActiveSheet
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = lastrow To 1 Step -1
lastcol = .Cells(i, .Columns.Count).End(xlToLeft).Column
'integer division so as to get the number of value pairs
numrows = lastcol \ 2
'only do anything if we have more than one value pair
If numrows > 1 Then
'insert extra rows for extra value pairs
.Rows(i + 1).Resize(numrows - 1).Insert
'copy the titles down to all new rows
.Cells(i, "A").Copy .Cells(i, "A").Resize(numrows)
'a value pair at a time, cut and copy to next new row
For ii = 4 To lastcol Step 2
'target row is current row (i) + the value pair index ((ii /2)-1)
.Cells(i, ii).Resize(, 2).Cut .Cells(i + (ii / 2) - 1, "B")
Next ii
End If
Next i
End With
Application.ScreenUpdating = True
End Sub

Answer 2

This does it with arrays onto a new sheet
Sub climatefreak()
Dim lastrow&
Dim ws As Worksheet
Dim lastcolumn&
Dim idx&
Dim ClmIdx&
Dim tws As Worksheet
Dim i&
Dim trw&
Set tws = Sheets("Sheet3")
Set ws = ActiveSheet
With ws
lastrow = .Cells(.Rows.Count, 1).End(xlUp).Row
For idx = 1 To lastrow
Dim temparr
lastcolumn = .Cells(idx, .Columns.Count).End(xlToLeft).Column
temparr = Range(.Cells(idx, 1), .Cells(idx, lastcolumn)).Value
For i = LBound(temparr, 2) + 1 To UBound(temparr, 2) Step 2
trw = tws.Range("A" & tws.Rows.Count).End(xlUp).Row + 1
tws.Cells(trw, 1) = temparr(UBound(temparr, 1), 1)
tws.Cells(trw, 2).Resize(, 2) = Array(temparr(1, i), temparr(1, i + 1))
Next i
Next idx
End With
End Sub