Data verticalization - code optmization

[Coffeeboo]

Hi,

I've written below code to help transpose data tables according to attached picture, mainly because I love PTs and they are much more powerful when using only one column for data.
However, I'm pretty sure the code is suboptimal, mainly because I transcribed what I'd do manually instead of thinking of a more elegant solution.

How would you do it?

Best

Sub Verticalize_data()
Dim i As Integer, j As Integer, k As Integer, n As Integer
Dim rowmovefirst As Integer, rowmovelast As Integer, colcopyfirst As Integer, colcopynb As Integer, rowheaders As Integer, colvalheader As Integer


Application.ScreenUpdating = False


If MsgBox("This macro will run on the active worksheet, are you willing to continue?", 4) <> 6 Then Exit Sub
If MsgBox("Please make sure you allocated one blank column to receive the verticalized header value", 1) <> 1 Then Exit Sub


colvalheader = InputBox("Please give the rank/number of said column, eg 3 for col C", "Which column is that?")
rowheaders = InputBox("Please give the rank/number of said row", "Which row contains headers for the data?")
rowmovefirst = InputBox("Please give the rank/number of said row", "Which is the first row of the data table to modify?")
rowmovelast = InputBox("Please give the rank/number of said row", "Which is the last row of the data table to modify?")
colcopyfirst = InputBox("Please give the rank/number of said column, eg 3 for col C", "Which is the first column containing data to verticalize?")
colcopynb = InputBox("Please give the number of data columns we're turning into data lines", "How many columns are we copying in a single one")


For i = rowmovelast To rowmovefirst Step -1


    For j = 0 To colcopynb - 2 Step 1
    ActiveSheet.Rows(i + 1).Insert
    Next j
    
    For k = 0 To colcopynb - 1 Step 1
    Cells(i + k, colvalheader).Value = Cells(rowheaders, colcopyfirst + k).Value
    Cells(i + k, colcopyfirst).Value = Cells(i, colcopyfirst + k).Value
        For n = 1 To colvalheader - 1 Step 1
        Cells(i + k, n).Value = Cells(i, n).Value
        Next n
    Next k
Next i


Application.ScreenUpdating = True


End Sub

 

[offthelip]

I think your code has an error in it: is this line correct?

    Cells(i + k, colcopyfirst).Value = Cells(i, colcopyfirst + k).Value

You appear to be writing into the column you describe as "Which is the first column containing data to verticalize?")
Also you appear to be adding a row index "i" to a column index "k" is this correct??
It should be possible to make your code much more efficient by using variant arrays, but I can't do it I don't know what you are trying to do

 

[Coffeeboo]

Imagine you have 12 columns with numbers, one for each month, and the headers contain the month name
I want to turn that into a to columns table, one with the month, one with the data.
Once I've pasted February-Dec below Jan, instead of beside(that's the code just above), the line you mention will Copy & Paste the relevant value (1+5 for June, 6th Column) in the relevant Row (5 below Jan).
that line is the key of the transposition, and yes, it works perfectly (that I should have mentionned)
I'm just looking for more elegant/efficient solution, the base problem is solved.

 

[offthelip]

This code does what you are asking, it uses varaint arrays so it will be super fast:

Sub Verticalize_data()
Dim i As Integer, j As Integer, k As Integer, n As Integer
Dim rowmovefirst As Integer, rowmovelast As Integer, colcopyfirst As Integer, colcopynb As Integer, rowheaders As Integer, colvalheader As Integer
Dim outarr() As Variant

If MsgBox("This macro will run on the active worksheet, are you willing to continue?", 4) <> 6 Then Exit Sub
If MsgBox("Please make sure you allocated one blank column to receive the verticalized header value", 1) <> 1 Then Exit Sub


colvalheader = InputBox("Please give the rank/number of said column, eg 3 for col C", "Which column is that?")
rowheaders = InputBox("Please give the rank/number of said row", "Which row contains headers for the data?")
rowmovefirst = InputBox("Please give the rank/number of said row", "Which is the first row of the data table to modify?")
rowmovelast = InputBox("Please give the rank/number of said row", "Which is the last row of the data table to modify?")
colcopyfirst = InputBox("Please give the rank/number of said column, eg 3 for col C", "Which is the first column containing data to verticalize?")
colcopynb = InputBox("Please give the number of data columns we're turning into data lines", "How many columns are we copying in a single one")



hdrs = Range(Cells(rowheaders, colcopyfirst), Cells(rowheaders, colcopyfirst + colcopynb))
datar = Range(Cells(rowmovefirst, colcopyfirst), Cells(rowmovelast, colcopyfirst + colcopynb))
ReDim outarr(1 To UBound(datar, 1) * (1 + colcopynb), 1 To 2)
indi = 1
For i = 1 To UBound(hdrs, 2)
 For j = 1 To UBound(datar, 1)
  outarr(indi, 1) = hdrs(1, i)
  outarr(indi, 2) = datar(j, i)
  indi = indi + 1
 Next j
Next i

Range(Cells(1, colvalheader), Cells(indi - 1, colvalheader + 1)) = outarr


End Sub