Pages - Menu

Wednesday, January 7, 2015

Excel: Merge cells in rows having same values

All most people like me and you often use Excel to process Data. Some times you get a Data with cells in rows having same values, and you want to merge them into 1 cell by each column. For example, you have a Data like the screenshot below:

And you want to achieve new Data as the following:

In which, SUM column will have new value = SUM of rows on AllOrHalf column which are belong to the merged cell.

In this article, I'll show you a solution using VBA to make this work. On the sheet, press Alt+F11 to open Visual Basic Editor (VBE). Right click on your workbook name in the Project-VBAProject pane (at the top left corner of the editor window) and select Insert >> Module from the context menu.


Copy below code to the window:

Option Explicit

Private Sub MergeCells()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim rngMerge As Range, cell As Range
    Dim nrow As Integer: nrow = 0
    Dim continue As Boolean: continue = True
    Dim totalLeave As Double: totalLeave = 0
    Set rngMerge = Range("A2:A9") 'range to check
    

    For Each cell In rngMerge
        Do
            totalLeave = totalLeave + cell.Offset(nrow, 5).Value
            If cell.Offset(nrow, 0).Value = cell.Offset(nrow + 1, 0).Value _
              And cell.Offset(nrow, 1).Value = cell.Offset(nrow + 1, 1).Value _
              And cell.Offset(nrow, 2).Value = cell.Offset(nrow + 1, 2).Value _
              And cell.Offset(nrow, 3).Value = cell.Offset(nrow + 1, 3).Value _
              And IsEmpty(cell) = False Then
                nrow = nrow + 1 'check next row
                continue = True
            Else
                continue = False
            End If
        Loop Until continue = False
        If nrow > 0 Then
            Range(cell.Offset(0, 3), cell.Offset(nrow, 3)).Merge
            Range(cell.Offset(0, 2), cell.Offset(nrow, 2)).Merge
            Range(cell.Offset(0, 1), cell.Offset(nrow, 1)).Merge
            Range(cell, cell.Offset(nrow, 0)).Merge
            nrow = 0
        End If
        cell.Offset(0, 3).Value = totalLeave 'assign value to SUM column
        totalLeave = 0
    Next
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Then press F5 to run the code. After that, you can format merged cells and you will get the result.

That's it. Any comment is welcome.