Set a Column in VBA as Header and Other Columns as Subheader

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 row is inserted 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 row is inserted 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.

Leave a Reply

Your email address will not be published. Required fields are marked *

Search