Saint's Log

Excel Macro to Merge First Two Cells of Each Column

Once in a while you may run into an Excel spreadsheet in which the first two rows have been used for column labels as a way to wrap text. Cleaning this up involves the straightforward task of merging the first two cells of each column. This rather tedious task is thankfully easily automated with an Excel VBA macro. See the code samples below:

Sample 1:

Sub MergeFirstTwoCellsInEachColumn()
    ' Bound the range selection as Ctrl+End would.
    ' See http://www.ozgrid.com/forum/showthread.php?t=17070
    Dim lastCol As Integer
    Dim row1LastCol As Integer
    Dim row2LastCol As Integer

    row1LastCol = Range("A1").currentRegion.End(xlToRight).Column
    row2LastCol = Range("B1").currentRegion.End(xlToRight).Column

    lastCol = WorksheetFunction.Max(row1LastCol, row2LastCol)

    ' Select the first two rows
    Rows("1:2").Select

    ' Merge the first two cells of each column
    For i = 1 To lastCol
        Dim columnCells

        columnCells = Selection.Columns(i).Cells

        Dim finalColumnText

        ' Concatenate contents of cells in rows 1 and 2 in this column
        ' separating them with a space
        finalColumnText = Trim(columnCells(1, 1) & " " & columnCells(2, 1))

        ' Clear both cells and store the new value in the first cell
        Selection.Columns(i).Value = ""
        Selection.Columns(i).Cells(1, 1) = finalColumnText

        ' Merge the cells
        Selection.Columns(i).Merge
    Next i
End Sub

One side effect of this code is that it merges cells in the columns up to the end of the range that would be selected if you pressed Ctrl + End. The columns to the right of this range are not merged, in effect leaving two rows in the spreadsheet for the headings. Enter Sample 2:

Sub MergeFirstTwoCellsInEachColumn2()
    ' Select the first two rows
    ' Bound the range selection as Ctrl+End would.
    ' See http://www.ozgrid.com/forum/showthread.php?t=17070
    Dim lastCol As Integer
    Dim row1LastCol As Integer
    Dim row2LastCol As Integer

    row1LastCol = Range("A1").currentRegion.End(xlToRight).Column
    row2LastCol = Range("B1").currentRegion.End(xlToRight).Column

    lastCol = WorksheetFunction.Max(row1LastCol, row2LastCol)

    ' Select the first two rows
    Rows("1:2").Select

    ' Combine the contents of the first two cells of each column
    For i = 1 To lastCol
        Dim columnCells
        Dim finalColumnText

        columnCells = Selection.Columns(i).Cells

        ' Concatenate contents of cells in rows 1 and 2 in this column
        ' separating them with a space
        finalColumnText = Trim(columnCells(1, 1) & " " & columnCells(2, 1))

        ' Store the new value in the first cell
        Selection.Columns(i).Cells(1, 1) = finalColumnText
    Next i

    ' Delete row 2
    Rows("2").Delete
End Sub

In MergeFirstTwoCellsInEachColumn2, the new column headings are simply written to the top cell and when this has been done for all columns, row two is deleted. This is perhaps the more elegant solution for most spreadsheets. A few comments on the code:

row1LastCol = Range("A1").currentRegion.End(xlToRight).Column

This line determines the last non-blank column in row 1. The currentRegion property of the Range object returns a “range bounded by any combination of blank rows and blank columns”. When called on the Range(“A1”) object, it effectively selects the same region as Ctrl + End. It’s then straightforward to inspect the End property and get the corresponding Column.

lastCol = WorksheetFunction.Max(row1LastCol, row2LastCol)

lastCol is the greater of the last columns in the first two rows (needed in case both rows don’t have the same column number as the last column). This lastCol value is important because without it, Excel will chew lots of CPU running the macro on all the columns beyond those spanned by the input data.