VBA code to merger cells improvment

[Mjk7239]

All,

Thanks in advance, I have this code that merges and centers cells with equal values, but it seems slow.

any ideas to speed it up would be appreciated.

Sub Merge_TimeScale()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

ActiveSheet.Range("AD11:HQ11").Select
    
MergeTL_A:

For Each rng In Selection
        
        If rng.Value = rng.Offset(0, 1).Value Then
            Range(rng, rng.Offset(0, 1)).Merge
             GoTo MergeTL_A
        End If
Next

ActiveSheet.Range("AD12:HQ12").Select
    
MergeTL_B:

For Each rng In Selection
        
        If rng.Value = rng.Offset(0, 1).Value Then
            Range(rng, rng.Offset(0, 1)).Merge
             GoTo MergeTL_B
        End If
Next

ActiveSheet.Range("AD13:HQ13").Select
    
MergeTL_C:

For Each rng In Selection
        
        If rng.Value = rng.Offset(0, 1).Value Then
            Range(rng, rng.Offset(0, 1)).Merge
             GoTo MergeTL_C
        End If
Next

ActiveSheet.Range("AD11:HQ13").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

 

[Michael M]

why would you want to merge cells. It will cause all sorts of problems when trying to do calculations, saving, copying, etc !!
Don't have Excel atm, so is UNTESTED

Sub Merge_TimeScale()
Dim cell As Variant
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each cell In Range("AD11:HQ11, AD12:HQ12, AD13:HQ13")
        If cell.Value = cell.Offset(0, 1).Value Then
            Range(cell, cell.Offset(0, 1)).Merge
        cell.HorizontalAlignment = xlCenter
        cell.VerticalAlignment = xlCenter
        End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub