Merge and Left Justify a Range of Rows in Excel

Question

I have a macro to select a range of cells on the same row and then merge & left justify that selection. I would like to enhance it to allow me to select a range or block of rows and perform the same action on each row in the range. Does anyone have some sample code to do something like that? Thanks! Craig

Answer 1

Here's one way to do it:

1. Get the last populated row in the worksheet via an auxiliary function.

2. Iterate over the rows, and for each row find the last column used via another auxiliary function.

3. Merge the resulting dynamically created selection and align left.

Important note from Microsoft: Only the data in the upper-left cell of a range (range: Two or more cells on a sheet. The cells in a range can be adjacent or nonadjacent.) of selected cells will remain in the merged cell. Data in other cells of the selected range will be deleted.

Option Explicit

Sub merge_left_justify()
    Dim i As Long
    Dim j As Long

    Dim last_row As Long
    Dim last_col As Long

    last_row = find_last_row(ThisWorkbook.ActiveSheet)

    Application.DisplayAlerts = False

    For i = 1 To last_row Step 1
        j = find_last_col(ThisWorkbook.ActiveSheet, i)
        Range(Cells(i, 1), Cells(i, j)).Select
        Selection.Merge
        Selection.HorizontalAlignment = xlLeft
    Next i

    Application.DisplayAlerts = True
End Sub

Function find_last_row(ByRef ws As Worksheet)
    Dim last_row
    last_row = Cells.Find(what:="*", after:=[a1], _
        searchorder:=xlByRows, searchdirection:=xlPrevious).row
    find_last_row = last_row
End Function

Function find_last_col(ByRef ws As Worksheet, ByVal row As Long)
    Dim last_col
    last_col = Cells(row, 255).End(xlToLeft).Column
    find_last_col = last_col
End Function

Answer 2

Actually to answer my own question, I played around with some code while looking for help and came up with this. Anyone see any issues with this? Seems to work except I still have a problem with the IF statement that is supposed to ignore and not merge any row that is blank, so it's just commented out here.

Sub MergeLeft()

Dim range As range

Dim i As Integer

Dim RowCount As Integer

' Merge Macro ' Keyboard Shortcut: Ctrl+Shift+A

RowCount = Selection.Rows.Count

For i = 1 To RowCount

Set range = Selection.Rows(i)

' If range(i) <> "" Then

    With range
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    range.Merge

' End If

Next i

End Sub