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:
- Unmerge all cells in a selected range, and
- 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