[Excel VBA] How to Merge Cells with the Same Value in a Column

When organizing data in Excel, “Merge Cells” is useful for grouping consecutive cells with the same text to make them easier to read.

In this article, I will explain how to automatically merge cells with the same value in a column using VBA.

Prerequisites

The prerequisites for using this code are as follows:

• Target Table: The row and column ranges of the target table must be set in advance (e.g., Rows 19-25, Columns A-C).
• Empty Cells: Empty cells are excluded from merging.
• Merge Rule: Adjacent cells with the same value within a column will be merged into one cell.
• Excel Environment: VBA must be enabled, and macros must be executable.

VBA Code to Merge Cells with the Same Value

By using the following code, you can merge cells with the same value within the specified column range.

Sub MergeSameValueCells()
    Dim outputSheet As Worksheet
    Dim rangeAddress As Variant
    Dim currentRange As Range
    Dim cell As Range
    Dim startCell As Range

    ' Set the output sheet
    Set outputSheet = ThisWorkbook.Sheets("SheetName") ' Change the sheet name as appropriate

    ' Set ranges to merge (e.g., A19:A25, B19:B25, C19:C25)
    Dim rangesToMerge As Variant
    rangesToMerge = Array("A19:A25", "B19:B25", "C19:C25", "G19:G25") ' Adjust as needed

    ' Disable alert messages for cell merging
    Application.DisplayAlerts = False

    ' Process each specified range
    For Each rangeAddress In rangesToMerge
        Set currentRange = outputSheet.Range(rangeAddress)
        Set startCell = Nothing ' Initialize start cell

        For Each cell In currentRange
            If cell.Value <> "" Then
                If startCell Is Nothing Then
                    ' Set start cell
                    Set startCell = cell
                ElseIf cell.Value <> startCell.Value Then
                    ' If values are different, merge
                    If Not startCell Is Nothing Then
                        outputSheet.Range(startCell, cell.Offset(-1, 0)).Merge
                    End If
                    Set startCell = cell
                End If
            Else
                ' If empty cell, skip merge
                If Not startCell Is Nothing Then
                    outputSheet.Range(startCell, cell.Offset(-1, 0)).Merge
                End If
                Set startCell = Nothing
            End If
        Next cell

        ' Merge the last cell range
        If Not startCell Is Nothing Then
            outputSheet.Range(startCell, currentRange.Cells(currentRange.Cells.Count)).Merge
        End If
    Next rangeAddress

    ' Re-enable alert messages
    Application.DisplayAlerts = True
End Sub

Explanation of the Code

1. Specify Target Sheet

Set outputSheet = ThisWorkbook.Sheets("SheetName") Specify the sheet to be processed. Please change the sheet name as appropriate.

2. Specify Merge Ranges

rangesToMerge = Array("A19:A25", "B19:B25", ...) Specify the column ranges to be merged in an array. Add or change ranges as needed.

3. Determine Cell Value and Merge

If cell.Value <> startCell.Value Then
    outputSheet.Range(startCell, cell.Offset(-1, 0)).Merge
End If

If adjacent cell values are different, the range is merged. Empty cells are skipped and excluded from merging.

4. Disable Warning Messages

Application.DisplayAlerts = False This disables the warning message that usually appears when merging cells (Excel normally warns that only the top-left value will be kept).

Summary

Using this VBA code, you can automatically merge consecutive cells with the same value in a table to organize your data. It is very useful when you have a lot of data or frequent merging tasks. Please try it out.