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 *

Share
Additional Info