In this article we will look at an example of how to transform columns into headers and sub-headers using Excel VBA.

Example 1:

So, let’s say you have a monthly expense report like this in a sheet called Expenses.

And you need to transform the columns Wages, Lease and Office Supplies into sub-headers for each month, in a format like this into a sheet called Output

Here is how we can achieve this. First we get the last row on the expense sheet so that we can loop through each row, as shown below:

 Set expenseSheet = Sheets("Expenses")
 Set outputSheet = Sheets("Output")

 'Get the last row from the expense sheet
 lastExpenseRow = expenseSheet.Cells(Rows.Count, 1).End(xlUp).Row

 For currentExpenseRow = 2 To lastExpenseRow

'Actual code goes here

Next currentExpenseRow


Next, within the for loop, for each row we get the number of columns. Most of the times, this will be same for all rows and can be hard-coded outside the for loop (as we have done in the next example).

 'get the number of columns in the current row
 noOfCols = expenseSheet.Cells(currentExpenseRow, Columns.Count).End(xlToLeft).Column


Then, get the row number to paste into.

 '+2 so that a blank <a href="https://software-solutions-online.com/insert-rows-vba/" >row is inserted</a> between two months
 rowToPaste = outputSheet.Cells(Rows.Count, 2).End(xlUp).Row + 2


Note: As we will be leaving a blank row in between 2 months, we are using + 2 at the end instead of + 1
While transforming data, we will first copy the name of the month

 'copy the month name
 expenseSheet.Cells(currentExpenseRow, 1).Copy Destination:=outputSheet.Cells(rowToPaste, 1)


The actual expenses will be pasted from the next row, so increment the counter

 'increment the row on the output sheet
 rowToPaste = rowToPaste + 1


For all the remaining columns (the expense columns), we will copy the expense header and the expense data from each column (of the respective month) and paste in the subsequent rows (for that month), like this

'For all the remaining expense columns
For colNo = 2 To noOfCols

'First copy the expense header
expenseSheet.Cells(1, colNo).Copy Destination:=outputSheet.Cells(rowToPaste, 1)

'And then the actual expenses for the corresponding month
expenseSheet.Cells(currentExpenseRow, colNo).Copy Destination:=outputSheet.Cells(rowToPaste, 2)

rowToPaste = rowToPaste + 1
Next colNo


Here is the entire code put together.

Sub colToHeaders()

Dim expenseSheet As Worksheet, outputSheet As Worksheet
Dim currentExpenseRow As Long, lastExpenseRow As Long, rowToPaste As Long
Dim noOfCols As Long, colNo As Long

Set expenseSheet = Sheets("Expenses")
Set outputSheet = Sheets("Output")

'get the last row from the expense sheet
lastExpenseRow = expenseSheet.Cells(Rows.Count, 1).End(xlUp).Row

For currentExpenseRow = 2 To lastExpenseRow

With expenseSheet

'get the number of columns in the current row
noOfCols = .Cells(currentExpenseRow, Columns.Count).End(xlToLeft).Column

'+2 so that a blank <a href="https://software-solutions-online.com/insert-rows-vba/">row is inserted</a> between two months
rowToPaste = outputSheet.Cells(Rows.Count, 2).End(xlUp).Row + 2

'copy the month name
.Cells(currentExpenseRow, 1).Copy Destination:=outputSheet.Cells(rowToPaste, 1)

'increment the row on the output sheet
rowToPaste = rowToPaste + 1

'For all the remaining expense columns
For colNo = 2 To noOfCols

'First copy the expense header
.Cells(1, colNo).Copy Destination:=outputSheet.Cells(rowToPaste, 1)

'And then the actual expenses for the corresponding month
.Cells(currentExpenseRow, colNo).Copy Destination:=outputSheet.Cells(rowToPaste, 2)

rowToPaste = rowToPaste + 1
Next colNo

End With

Next currentExpenseRow
End Sub


Example 2:
Let us look at how to do the reverse — that is — you have data in headers and sub-headers format like this in the expenses sheet,

And you want to convert it into column format like this in the output sheet

Here we will assume that each month has exactly same sub-headers below it. The code is pretty similar to the above one and hence, the explanation is provided in the comments itself, in code below.

Sub headersToCol()

Dim expenseSheet As Worksheet, outputSheet As Worksheet
 Dim currentExpenseRow As Long, lastExpenseRow As Long, rowToPaste As Long
 Dim noOfCols As Long, colNo As Long

 Set expenseSheet = Sheets("Expenses")
 Set outputSheet = Sheets("Output")

 'get the last row from the expense sheet
 lastExpenseRow = expenseSheet.Cells(Rows.Count, 1).End(xlUp).Row

 'This is the number of sub-headers under each month
 noOfCols = 3

 'Loop through each row on the expense sheet
 For currentExpenseRow = 3 To lastExpenseRow

 With expenseSheet

 'Get the row to paste into the output sheet
 rowToPaste = outputSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1

 'copy the month name
 .Cells(currentExpenseRow, 1).Copy Destination:=outputSheet.Cells(rowToPaste, 1)

 'increment the row on the output sheet as the expense data starts from the next row
 currentExpenseRow = currentExpenseRow + 1

 'For each of the expense columns below every month
 'We are looping till noOfCols + 1 as the expense columns start from column 2
 For colNo = 2 To noOfCols + 1

 'Copy the actual expenses for the corresponding month
 .Cells(currentExpenseRow, 2).Copy Destination:=outputSheet.Cells(rowToPaste, colNo)

 'Go to the next expense row
 currentExpenseRow = currentExpenseRow + 1

 Next colNo

 End With

 'Increment for the next month
 rowToPaste = rowToPaste + 1

 Next currentExpenseRow
End Sub


Thus, we can easily do column to headers / sub-headers transformation and vice-versa using the two example codes above. What’s the next step? Let’s say you want to take these values and output them to Word, then click to find out more.