Forum Discussion

besthannie25's avatar
besthannie25
Copper Contributor
Jun 05, 2024

Merge cells containing the same information in multiple tables with macro

Hi everyone, I'm new to this and I'm trying to figure out how to do the following.
I have an excel file, the first sheet is the main table and from this table different subtables are formed and each table is on a different sheet.
For a better visualization of the data, the user needs to see these excel tables with the records grouped together.
All tables have the same columns only their data changes.
As you can see in the first image the table has each record separated in each row but the user wants to view it like the second image in which the table is merged in the records that contain the same information.

 

 


I already tried to do this in power automate with an office script connector but I couldn't get it to work and the macro I have is the following, but it only does this merge in the range of cells that I specify and only in a single table.

Sub MergeSameCell()
Set myRange=("DataDesk")
MergeSame:
For Each Cell In myRange
 If cell.Value = cell.Offset(1, 0).Value And Not IsEmpty(cell) Then
 Range(cell, cell.Offset(1, 0)).Merge
 cell.VerticalAlignment = xlCenter
 GoTo MergeSame
 End If
Next cell

End Sub

I would greatly appreciate your help.

Excel
Excel for web
Macros and VBA
Office Scripts
  • peiyezhu's avatar
    peiyezhu
    Bronze Contributor
    Jun 06, 2024

    Sub MergeSameCell(myRange)
    'modify here
    'Set myRange=("A5:F17")
    MergeSame:
    For Each Cell In myRange
     If cell.Value = cell.Offset(1, 0).Value And Not IsEmpty(cell) Then
     Range(cell, cell.Offset(1, 0)).Merge
     cell.VerticalAlignment = xlCenter
     GoTo MergeSame
     End If
    Next cell

    End Sub
    sub main()
    ' Loop through each worksheet in the workbook
        For Each ws In ThisWorkbook.Worksheets
        set myRange=ws.cells(2,1).currentRange
    MergeSame myRange
        Next ws

    end sub

     

     

     

     

    Sub MergeSameCell(myRange As Range)
    'modify here
    'Set myRange=("A5:F17")

MergeSame:
    For Each cell In myRange
        If cell.Value = cell.Offset(1, 0).Value And Not IsEmpty(cell) Then
            Range(cell, cell.Offset(1, 0)).Merge
            cell.VerticalAlignment = xlCenter
            GoTo MergeSame
        End If
    Next cell
End Sub

Sub main()
    Dim ws As Worksheet
    Dim myRange As Range
    
    ' Loop through each worksheet in the workbook
    For Each ws In ThisWorkbook.Worksheets
        Set myRange = ws.Range("A5:F17") ' Define the range here
        MergeSameCell myRange
    Next ws
End Sub


     

    • besthannie25's avatar
      besthannie25
      Copper Contributor
      Jun 06, 2024
      Hi, it works but is there any way to make the window that says: "merging cells only keeps the upper-left value and discards other values" ​​not appear? because you have to click on it several times to perform the action. And if i click on cancel button this message appear: Run time error '1004' Application-defined or object-defined error, and mark the following line in yellow
      Range(cell, cell.Offset(1, 0)).Merge
      • HansVogelaar's avatar
        HansVogelaar
        MVP
        Jun 07, 2024

        besthannie25 

        Insert the following line above the For ... Next loop:

            Application.DisplayAlerts = False

        and below it:

            Application.DisplayAlerts = True

Resources