VBA Merge & Center The Adjacent Rows With Same Data
➤ If there are same data in the adjacent rows, the same cells
are merged into one cell and centered.
In this way, the data looks more neat .
Our macro to merge and center cells :
Sub merge_center()
Dim i, a As Long, one, two As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = 2 To Cells(Rows.Count, "A").End(3).Row
If Cells(i, "A") = Cells(i + 1, "A") Then
one = Cells(i, "A").Address
For a = i + 1 To Cells(Rows.Count, "A").End(3).Row
If Cells(a, "A") <> Cells(a + 1, "A") Then
two = Cells(a, "A").Address
Exit For
End If
Next a
Range(one & ":" & two).merge ' Same cells are merged
Range(one & ":" & two).Interior.ColorIndex = 34 ' Background is painted
Else
End If
Range("A2:A" & i).HorizontalAlignment = xlCenter
Range("A2:A" & i).VerticalAlignment = xlCenter
Next i
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Dim i, a As Long, one, two As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = 2 To Cells(Rows.Count, "A").End(3).Row
If Cells(i, "A") = Cells(i + 1, "A") Then
one = Cells(i, "A").Address
For a = i + 1 To Cells(Rows.Count, "A").End(3).Row
If Cells(a, "A") <> Cells(a + 1, "A") Then
two = Cells(a, "A").Address
Exit For
End If
Next a
Range(one & ":" & two).merge ' Same cells are merged
Range(one & ":" & two).Interior.ColorIndex = 34 ' Background is painted
Else
End If
Range("A2:A" & i).HorizontalAlignment = xlCenter
Range("A2:A" & i).VerticalAlignment = xlCenter
Next i
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
No comments:
Post a Comment