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.

No comments:

Post a Comment

Subscribe to RSS Feed Follow me on Twitter!