This adds a new sheet called MergeReport. The macro will not be able to create the new sheet if the spreadsheet is in read-only status. Here's a sample for the attached document.
- Merged cell report horizontal.png (58.6 KiB) Viewed 1231 times
In the unlikely case that a sheet contains more merged cell ranges than will fit in a row of the report sheet, the macro creates additional rows for that sheet. if you want to limit the number of columns the macro uses, perhaps to create a report which you can print, create a defined name MergeReportDataColumns to indicate how many columns of ranges to report per row. The defined name must be set to a positive unsigned integer, not a cell reference or formula. Here is the report with MergeReportDataColumns set to 1.
- Merged cell report vertical.png (88.92 KiB) Viewed 1231 times
I learned quite a bit about macros and the UNO API when developing this report. People with more macro experience may know of easier ways to write this program. Create a topic in the Macros and UNO API forum if you want to discuss the project. The macro does not support sheet names which contain a period. I understand how to add that support, but it seemed like an unnecessary complication for the macro.
Option Explicit
Sub MergeReport ' Create report of merged cell ranges
' V1R5M0 2025-08-07
Const REPORT = "MergeReport" ' Name of report sheet
Const MRDC = "MergeReportDataColumns" ' Defined name for report data columns
Dim sheets As Variant ' Sheets in document {Spreadsheets}
Dim rsheet As Variant ' Report sheet {SheetCellRange}
Dim sheet As Variant ' Current sheet {SheetCellRange}
Dim view As Variant ' Document view {SpreadsheetView}
Dim uniqs As Variant ' Contaier of ranges {UniqueCellFormatRanges}
Dim ranges As Variant ' One set of ranges formatted alike {SheetCellRanges}
Dim range As Variant ' One of the ranges formatted alike {SheetCellRange}
Dim cell As Variant ' A cell in a range {Cell}
Dim cursor As Variant ' Cursor for range traversal {SheetCellCursor}
Dim dnames As Variant ' Defined names {NamedRanges}
Dim mrange As String ' Merged cell range as First:Last, like D1:I1
Dim dcols As String ' Content in defined name, as string
Dim dmax As Long ' Defined name cmax value
Dim s As Long, u As Long, r As Long ' Indices for sheets, uniqs, ranges
Dim rrow As Long, rcol As Long ' Position in report sheet
Dim irow As Long, icol As Long ' Index of cells in range
Dim cmax As Long ' Maximum column supported in spreadsheets
Dim umax As Long ' Maximum used column in report sheet
Dim srow As Long ' Start row for this sheet
Dim total As Long ' Total count of merged cells
sheets = ThisComponent.Sheets ' Sheets in spreadsheet
If sheets.hasByName(REPORT) Then sheets.removeByName(REPORT) ' Delete any existing report sheet
sheets.insertNewByName(REPORT,sheets.Count) ' Add report sheet at end
rsheet = sheets.getByName(REPORT) ' Report sheet
rsheet.getCellByPosition(0,0).String = "Sheet" ' Build headings in column A ...
rsheet.getCellByPosition(1,0).String = "Merges" ' ... and column B of row 1
umax = 0 : total = 0 ' No merged cell columns used yet
rrow = 0 ' Row in report sheet
cmax = rsheet.Columns.Count-1 ' Largest column in a sheet
dnames = Thiscomponent.NamedRanges ' Defined names in spreadsheet
Do ' Test for our defined name
If Not dnames.hasByName(MRDC) Then Exit Do ' Our defined name was not found
dcols = dnames.getByName(MRDC).Content ' Get its content
If dcols Like "*[!0-9]*" Then Exit Do ' Found nondigit, ignore MRDC
If dcols = "0" Then Exit Do ' Content is "0", ignore MRDC
If LEN(dcols) > LEN(CSTR(cmax)) Then Exit Do ' Content too long, ignore MRDC
dmax = VAL(dcols)+1 ' Get new cmax value from defined name
If dmax<=cmax Then cmax = dmax ' New cmax value, if not too large
Loop While False ' Don't loop again
For s = 0 to sheets.Count-2 : sheet = sheets(s) ' Loop through sheets, except MergeReport
rrow = rrow+1 : rcol = 2 : srow = rrow ' Start new row in column C
rsheet.getCellByPosition(0,rrow).String = sheet.Name ' Put sheet name in column A
uniqs = sheet.UniqueCellFormatRanges ' Containers of ranges in sheet formatted alike
For u = 0 to uniqs.Count-1 : ranges = uniqs(u) ' Loop through UniqueCellFormat containers
For r = 0 to ranges.Count-1 : range = ranges(r) ' Loop through ranges with similar formats
If Not range.IsMerged Then Exit For ' Skip ranges without the IsMerged property
For irow = 0 To range.Rows.Count-1 ' Loop through rows of range
For icol = 0 To range.Columns.Count-1 ' Loop through columns of range
cell = range.getCellByPosition(icol,irow) ' Cell at the beginning of a merged range
cursor = sheet.createCursorByRange(cell) ' Create cursor at that cell
cursor.collapseToMergedArea() ' Expand range to merged area
mrange = cursor.AbsoluteName ' $Sheet1.$D$1:$I$1
mrange = RIGHT(mrange,LEN(mrange)-INSTR(mrange,".")) ' $D$1:$I$1
mrange = JOIN(SPLIT(mrange,"$"),"") ' D1:I1
If rcol>cmax Then ' Begin new row if current one is full
rrow = rrow+1 : rcol = 2 ' Set row and column indices
rsheet.getCellByPosition(0,rrow).String = sheet.Name ' Put sheet name in column A
End If ' End of new row initialization
rsheet.getCellByPosition(rcol,rrow).String = mrange ' Store merged range in report sheet
If rcol>umax Then ' Need to create new column heading
cell = rsheet.getCellByPosition(rcol,0) ' Get cell in first row for new column heading
cell.String = FORMAT(rcol-1,"\#0") ' #1 #2 #3 #4 …
umax = rcol ' Set new column maximum
End If ' End of column heading creation
rcol = rcol+1 ' Step to next column in report sheet
Next icol ' Done with columns in range
Next irow ' Done with rows in range
Next r ' Done with container of similar formats
Next u ' Done with UniqueCellFormatRanges
u = (rrow-srow)*(cmax-1)+rcol-2 ' Cells used for this sheet
total = total+u ' Add count for sheet to total
rsheet.getCellByPosition(1,rrow).Value = u ' Put count for sheet in column B
Next s ' Done with sheet
rsheet.getCellByPosition(0,rrow+1).String = "*Total*" ' Add row for total heading
rsheet.getCellByPosition(1,rrow+1).Value = total ' Put total of merged cell counts in it
rsheet.Columns(0).OptimalWidth = True ' Set optimal width for column A
rsheet.Columns(1).OptimalWidth = True ' Set optimal width for column B
view = ThisComponent.CurrentController ' Document view
view.ActiveSheet = rsheet ' Point view at report sheet
view.freezeAtPosition(2,1) ' Freeze view at C2
End Sub