none
Macro for Row Merge in Excel RRS feed

  • Question


  • Hello All,

    I have a Excel file has 4000 rows and text in few rows are separated by other rows.

    If you look into the column "B" the text are separated by 2, 3, 4 or 5 rows, actually it should be set in one single row.


    I have highlighted few rows with colors for internal reference.

    Is there any macro to merge the rows for the entire sheet.

    Below the link for the sample excel file

    https://gofile.io/?c=zylZO4


    John

    Saturday, August 10, 2019 6:09 PM

Answers

  • Okay, please try this and let me know if this is working as desired now.

    Sub MergeCells()
    Dim ws As Worksheet
    Dim lr As Long, i As Long, c As Long
    Dim str As String
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set ws = Worksheets("Sheet1")
    lr = ws.Cells(Rows.Count, 2).End(xlUp).Row
    
    For i = lr To 6 Step -1
        If ws.Cells(i, 5) = "" And ws.Cells(i, 1) = "" And ws.Cells(i, 2) <> "" Then
            ws.Range(ws.Cells(i, 1), ws.Cells(i - 1, 1)).Merge
            ws.Range(ws.Cells(i, 1), ws.Cells(i - 1, 1)).HorizontalAlignment = xlCenter
            ws.Range(ws.Cells(i, 1), ws.Cells(i - 1, 1)).VerticalAlignment = xlCenter
            str = ws.Cells(i - 1, 2) & Chr(10) & ws.Cells(i, 2)
            ws.Range(ws.Cells(i, 2), ws.Cells(i - 1, 2)).Merge
            ws.Range(ws.Cells(i, 2), ws.Cells(i - 1, 2)).Value = str
            ws.Range(ws.Cells(i, 2), ws.Cells(i - 1, 2)).HorizontalAlignment = xlLeft
            ws.Range(ws.Cells(i, 2), ws.Cells(i - 1, 2)).VerticalAlignment = xlCenter
            For c = 3 To 5
                ws.Range(ws.Cells(i, c), ws.Cells(i - 1, c)).Merge
                ws.Range(ws.Cells(i, c), ws.Cells(i - 1, c)).HorizontalAlignment = xlCenter
                ws.Range(ws.Cells(i, c), ws.Cells(i - 1, c)).VerticalAlignment = xlCenter
            Next c
        End If
        str = ""
    Next i
    Application.ScreenUpdating = True
    End Sub


    Subodh Tiwari (Neeraj) sktneer

    Sunday, August 11, 2019 5:02 AM
  • Hi Subodh,

    Yes it works Perfect!

    You saved my Life, thank you so much for your timely support on this!!!!

    Sunday, August 11, 2019 5:23 AM

All replies

  • You want to merge the cells in column A not the Rows. Right?

    Please give this a try and see if this is what you are trying to achieve.

    Before trying this macro, create a backup of Sheet1.

    Sub MergeCells()
    Dim ws As Worksheet
    Dim lr As Long, i As Long
    
    Application.ScreenUpdating = False
    Set ws = Worksheets("Sheet1")
    lr = ws.Cells(Rows.Count, 2).End(xlUp).Row
    
    For i = lr To 6 Step -1
        If ws.Cells(i, 5) = "" And ws.Cells(i, 1) = "" And ws.Cells(i, 2) <> "" Then
            ws.Range(ws.Cells(i, 1), ws.Cells(i - 1, 1)).Merge
            ws.Range(ws.Cells(i, 1), ws.Cells(i - 1, 1)).HorizontalAlignment = xlCenter
            ws.Range(ws.Cells(i, 1), ws.Cells(i - 1, 1)).VerticalAlignment = xlCenter
        End If
    Next i
    Application.ScreenUpdating = True
    End Sub


    Subodh Tiwari (Neeraj) sktneer

    Saturday, August 10, 2019 7:32 PM
  • HI Subodh,

    I want to merge the cells in Row.

    It merges the cells in column A correctly, I want it should merge the cells in column B also when it merging cells in column A

    Sunday, August 11, 2019 12:12 AM
  • For Example

    The rows 10 & 11 should merge and appears as "Advisory Vote to Ratify Named Executive Officers' Compensation" in Cell "B10"

    Sunday, August 11, 2019 12:16 AM
  • Okay, please try this and let me know if this is working as desired now.

    Sub MergeCells()
    Dim ws As Worksheet
    Dim lr As Long, i As Long, c As Long
    Dim str As String
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set ws = Worksheets("Sheet1")
    lr = ws.Cells(Rows.Count, 2).End(xlUp).Row
    
    For i = lr To 6 Step -1
        If ws.Cells(i, 5) = "" And ws.Cells(i, 1) = "" And ws.Cells(i, 2) <> "" Then
            ws.Range(ws.Cells(i, 1), ws.Cells(i - 1, 1)).Merge
            ws.Range(ws.Cells(i, 1), ws.Cells(i - 1, 1)).HorizontalAlignment = xlCenter
            ws.Range(ws.Cells(i, 1), ws.Cells(i - 1, 1)).VerticalAlignment = xlCenter
            str = ws.Cells(i - 1, 2) & Chr(10) & ws.Cells(i, 2)
            ws.Range(ws.Cells(i, 2), ws.Cells(i - 1, 2)).Merge
            ws.Range(ws.Cells(i, 2), ws.Cells(i - 1, 2)).Value = str
            ws.Range(ws.Cells(i, 2), ws.Cells(i - 1, 2)).HorizontalAlignment = xlLeft
            ws.Range(ws.Cells(i, 2), ws.Cells(i - 1, 2)).VerticalAlignment = xlCenter
            For c = 3 To 5
                ws.Range(ws.Cells(i, c), ws.Cells(i - 1, c)).Merge
                ws.Range(ws.Cells(i, c), ws.Cells(i - 1, c)).HorizontalAlignment = xlCenter
                ws.Range(ws.Cells(i, c), ws.Cells(i - 1, c)).VerticalAlignment = xlCenter
            Next c
        End If
        str = ""
    Next i
    Application.ScreenUpdating = True
    End Sub


    Subodh Tiwari (Neeraj) sktneer

    Sunday, August 11, 2019 5:02 AM
  • Hi Subodh,

    Yes it works Perfect!

    You saved my Life, thank you so much for your timely support on this!!!!

    Sunday, August 11, 2019 5:23 AM
  • You're welcome John! Glad it worked as desired.

    Subodh Tiwari (Neeraj) sktneer

    Sunday, August 11, 2019 6:06 AM