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 currentExpenseRowNext, 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).ColumnThen, 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 + 2Note: 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 + 1For 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 colNoHere 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(&amp;quot;Expenses&amp;quot;) Set outputSheet = Sheets(&amp;quot;Output&amp;quot;) '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 SubExample 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(&amp;quot;Expenses&amp;quot;) Set outputSheet = Sheets(&amp;quot;Output&amp;quot;) '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 SubThus, 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.