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.
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.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
That's it. Any comment is welcome.
No comments:
Post a Comment