VBA code to Merge two rows (if it isn't empty) starting from 2nd row up to a limit (for columns A,B,C,D,E,F,G,H)

[amaresh achar]

Hello... I came across the following post similar to mine... But I need a minor tweak... i.e. It should stop merging operation up to a row limit (say row 1034)

VBA code to merge every three rows starting from second row

Hi everyone, I need a VBA code that would merge every three rows (if data exists) starting from row 2, and covering column range of A to lets say J. Many thanks in advance,

www.mrexcel.com

Can anyone please help me with this...??

Thanks in advance...

 

[Joe4]

If you are talking about the code Dante posted there, here is how to modify it to stop at row 1034:

Sub Macro4()

    Dim lr As Long
   
'   Find last row in column A with data
    lr = Range("A" & Rows.Count).End(xlUp).Row
   
'   Cap lr at 1034
    If lr > 1034 Then lr = 1034

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    For i = 2 To lr Step 3
        For j = 1 To Columns("J").Column
            With Range(Cells(i, j), Cells(i + 2, j))
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .MergeCells = True
            End With
        Next
    Next

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
   
End Sub

 

[amaresh achar]

If you are talking about the code Dante posted there, here is how to modify it to stop at row 1034:

Sub Macro4()

    Dim lr As Long
  
'   Find last row in column A with data
    lr = Range("A" & Rows.Count).End(xlUp).Row
  
'   Cap lr at 1034
    If lr > 1034 Then lr = 1034

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    For i = 2 To lr Step 3
        For j = 1 To Columns("J").Column
            With Range(Cells(i, j), Cells(i + 2, j))
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .MergeCells = True
            End With
        Next
    Next

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
  
End Sub

Thank You Sir... Working great....!!!

 

[Joe4]

You are welcome.
Glad I was able to help.