CODEWITHSUNDEEP
excel
Margot Vanlaet
Margot Vanlaet

Reputation: 1

How to efficiently merge cells in Excel using a macro?

I am trying to develop an index, but in order to make correct calculations and pivot tables, I need to merge some cells. Doing this manually would take a lot of time, therefore I am looking for a more efficient way. I assume a Macro might help me out here, yet I do not really know how to get started.

A bit of context on the datasheet: The info in cells E until AB was used to calculate the numbers in cells AC, AD, AE and AF. This information was hided as these cells do not need to be merged.

I am in the need of a macro that:

Can somebody help me out? Thank you in advance for the help!!

https://i.sstatic.net/LShf3.png

This should be a result, but then accomplished with a macro so that it can be done efficiently for larger lists:https://i.sstatic.net/tm4RQ.png

Upvotes: 0

Views: 52

Answers (1)

Evil Blue Monkey
Evil Blue Monkey

Reputation: 2609

Try this code:

Sub SubMerge()
    
    'Declarations.
    Dim RngName As Range
    Dim RngFirstCat As Range
    Dim DblTotalCat As Double
    Dim DblCounter01 As Double
    
    'Settings.
    Set RngName = Range("A2")
    Set RngFirstCat = Range("AC2")
    DblTotalCat = 4
    
    'Deactivating display alerts.
    Application.DisplayAlerts = False
    
    'Repeat until an empty cell is found.
    Do Until RngName.Value = ""
        
        'Repeat until a different value is found.
        Do Until RngName.Offset(1, 0).Cells(RngName.Cells.Count, 1).Value <> RngName.Cells(1, 1).Value
            
            'Increasing the size of RngName by 1 row.
            Set RngName = RngName.Resize(RngName.Rows.Count + 1)
            
        Loop
        
        'Checking if RngName has more than 1 row.
        If RngName.Rows.Count > 1 Then
            
            'Setting RngFirstCat.
            Set RngFirstCat = Cells(RngName.Row, RngFirstCat.Column).Resize(RngName.Rows.Count)
            
            'Covering each category.
            For DblCounter01 = DblTotalCat - 1 To 0 Step -1
                
                'Merging the cells.
                RngFirstCat.Offset(0, DblCounter01).Merge
                
            Next
        End If
        
        'Setting RngName for the next value.
        Set RngName = RngName.Cells(1, 1).Offset(RngName.Cells.Count)
        
    Loop
    
    'Deactivating display alerts.
    Application.DisplayAlerts = True
    
End Sub

Upvotes: 1

Related Questions