Do you sometimes receive a file with merged cells all over the place? Something like this:

The first thing I want to do in that situation is un-merge everything. Well, that’s easy enough. If I use the Merged Cells button on the ribbon, it will do this:

Ok, now I need to fill in the blank rows with the category header from the top of each row. I can do that using the useful technique of Go To Special/Blanks and enter a formula. Like this:

That is useful, but I don’t particularly like having formulas in those cells after I’m done. So then I would need to Copy/Paste Special/Values.

About 10 years ago, I wrote a macro that would:

  1. Unmerge all cells in a selected range, and
  2. Fill the component cells with the original value in the range

I called it UnmergeAndFill. This morning I expanded it and annotated it so I could share it here. The macro is called UnMergeAndReformatAllInRange. Rolls off the tongue, right?

Here’s how it works:

If you want to just fill one row of the resulting range, you can select either top, middle or bottom row and automatically center across selection:

Here’s the code. As always, I make no assertions that this is perfect. I only hope it will be useful or inspire you to automate your work even if only in a small way. You can double-click the code block below and copy it into your Personal Macro Workbook if you think it will be useful to you.

If you have any suggestions for improvements to my code or additional options that will improve the usability of this macro, please let me know in the comments.

Option Explicit

Public Sub UnMergeAndReformatAllInRange()

'#########################################
'#########################################
'Author: Owen Price - www.flexyourdata.com
'Date: 2022-03-12
'#########################################
'#########################################

Dim rng As Range 'the range that's selected before running this procedure
Dim c As Object 'an object representing a cell
Dim entered_action As String
Dim entered_output_row As String
Dim action As Integer 'an action to take after unmerging a cell
Dim output_row As Integer 'indicating which row of the unmerged cells to place the original value

action = 0 'the default action is "Fill"

enteraction:

entered_action = InputBox("What do you want to do after the ranges are un-merged?" & vbCrLf & _
                "0 = fill with current value" & vbCrLf & _
                "1 = center across selection" & vbCrLf & _
                "-1 = value in top-left cell only", "Un-Merge And Reformat", action) 'the current value of action is displayed in the input box
                
If StrPtr(entered_action) = 0 Then 'User pressed cancel or "x"

    Exit Sub
    
ElseIf Not IsNumeric(entered_action) Then 'User entered a value that wasn't a number

    MsgBox "You didn't enter a valid value" & vbCrLf & "Only numbers -1, 0 or 1 are allowed", vbCritical, "Un-Merge And Reformat"
    GoTo enteraction
    
Else 'User entered a number

    action = entered_action

End If


If Not (action = -1 Or action = 0 Or action = 1) Then 'User entered a number, but it wasn't a valid number
    
    'Inform the user they must enter a number, then return to the input box for entering the action
    MsgBox "You didn't enter a valid value" & vbCrLf & "Only numbers -1, 0 or 1 are allowed", vbCritical, "Un-Merge And Reformat"
    GoTo enteraction
    
End If

enteroutputrow:
If action = 1 Then 'User wants to center across selection

    entered_output_row = InputBox("Which row should receive the value?" & vbCrLf & _
                    "0 = the top row" & vbCrLf & _
                    "1 = the bottom row" & vbCrLf & _
                    "-1 = the middle row (if even rows, then middle - 1)", "Un-Merge And Reformat", 0)
    
    If StrPtr(entered_output_row) = 0 Then 'User clicked cancel or "x"
    
        GoTo enteraction 'return to the first dialog so user can select a different action if they want
        
    ElseIf Not IsNumeric(entered_output_row) Then 'the entered value was not a number
        
        'Inform the user they must enter a number, then return to the input box for entering the output_row
        MsgBox "You didn't enter a valid value" & vbCrLf & "Only numbers -1, 0 or 1 are allowed", vbCritical, "Un-Merge And Reformat"
        GoTo enteroutputrow
    
    Else
    
        'put the entered number into the integer variable
        output_row = entered_output_row
        
    End If
        
        
    If Not (output_row = -1 Or output_row = 0 Or output_row = 1) Then 'They entered a number, but it wasn't a valid number
        
        'Inform the user they must enter a number, then return to the input box for entering the output_row
        MsgBox "You didn't enter a valid value" & vbCrLf & "Only numbers -1, 0 or 1 are allowed", vbCritical, "Un-Merge And Reformat"
        GoTo enteroutputrow
        
    End If

End If


'Stop the Excel screen from flickering while the macro is running
Application.ScreenUpdating = False


'Store the entire selected range in a range variable
Set rng = Selection


'Now iterate through each cell in the selected range
For Each c In rng.Cells
    
    'If a cell is Merged, it has .MergeCells=True
    If c.MergeCells Then
    
        'Un-merge the cell and apply the reformatting selected by the user
        UnMergeThenReformat c.MergeArea, action, output_row
        
    End If
    
'go to the next cell in the selected range
Next c

'We must always reset this at the end
Application.ScreenUpdating = True

End Sub

Private Sub UnMergeThenReformat(merged_range As Range, action_after_merge As Integer, Optional output_row As Integer)

'#########################################
'#########################################
'Author: Owen Price - www.flexyourdata.com
'Date: 2022-03-12
'#########################################
'#########################################

Dim rng As Range
Dim c As Object
Dim txt As Variant
Dim r As Integer
Dim output_to_row As Integer
Dim row_count As Integer
Dim half_row_count As Double

    'use a shorter name (not really necessary)
    Set rng = merged_range
    
    'unmerge the cells
    rng.UnMerge
    
    'store the original value that was in the merged cell
    txt = rng.Cells(1, 1)
    
    Select Case action_after_merge
        Case -1 'Do nothing
        Case 0
        
            'put the original value in every cell in the range
            For Each c In rng.Cells
                c = txt
            Next c
            
        Case 1 'User selected center across selection
    
            'store the row count of the originally merged cell
            row_count = rng.Rows.Count
            
            'calculate the true middle of the row count (for use later)
            half_row_count = row_count / 2
        
            Select Case output_row
                Case 0 'User selected "Top row"
                    
                    output_to_row = 1
                    
                Case 1 'User selected "Bottom row"
                    
                    output_to_row = row_count
                    
                Case -1 'User selected "Middle row"
                
                    'E.g. if row_count = 4, then output to row 2
                    'if row_count = 5 then output to row 3
                    'if row_count = 6 then output to row 3
                    output_to_row = Int(half_row_count) + IIf(half_row_count = Int(half_row_count), 0, 1)
                    
                Case Else 'This should never happen, but included just in case
                
                    MsgBox "Invalid value for variable 'output_row'", vbCritical, "Un-Merge And Reformat"
                    Exit Sub
                    
            End Select
            
            'Apply the value to the correct output row
            'Loop through each row in the original merged range
            For r = 1 To row_count
            
                Select Case r
                    Case output_to_row 'this row receives the value and formatting
                    
                        'set the value in the left-most cell to the original value
                        rng.Cells(r, 1) = txt
                        
                        'set the horizontal alignment to center across the columns of the original range
                        rng.Rows(r).HorizontalAlignment = xlHAlignCenterAcrossSelection
                        
                    Case Else
                    
                        'If this is not the selected output row, make the value blank
                        rng.Cells(r, 1) = ""
                        
                        'don't change the formatting of the row
                        
                End Select
            Next r
            
        Case Else 'Do nothing
        
            MsgBox "Invalid value for variable 'output_row'", vbCritical, "Un-Merge And Reformat"
            Exit Sub
        
        
    End Select
     

End Sub