I want to merge a row of cells and combine into one cell

[lansy1]

This is easy to do one at a time. I have several rows so I would like to do this on a much larger scale. I can send screen shots to help further.

[Lupp]

Merging cells is the way into the mess. Concatenate the contents you want combined in an adjacent column by formulae.
Do not attach screenshots but a relevant example .ods.
You will need karma >= 3 anyway to be allowed to atach files.

[mariosv]

Up voted the question to raise the karma, I think the sample can be upload now.

[mark_t]

I think the following macro will help. You could assign it to an unused hot key if you are likely to use it often.

First format the top row of the table with merged cells, colors, number formats etc. Then select the range for the table directly below this top row. Then run the macro.

Macro uses the dispatch method for copy and paste special as I don’t know any other way of performing paste special from a macro.

Post comments if you have any problems.

REM  *****  BASIC  *****

Option Explicit

Sub FormatRange
'	Format selected Range to match the row above the selection

	Dim oCurSelection As Object
	Dim oController As Object
	Dim oSelRangeAddress As New com.sun.star.table.CellRangeAddress
	Dim oRefRangeAddress As New com.sun.star.table.CellRangeAddress
	Dim sSelAbsoluteName As String
	Dim sRefAbsoluteName As String
	
	oCurSelection = thisComponent.CurrentSelection
	sSelAbsoluteName = oCurSelection.AbsoluteName
	oSelRangeAddress = oCurSelection.RangeAddress
	
	If oSelRangeAddress.StartRow < 1 Then
		msgbox	"There is no row above the selection to copy formats."
		Exit Sub
	End If
	
	oRefRangeAddress = oSelRangeAddress
	oRefRangeAddress.StartRow = oSelRangeAddress.StartRow - 1
	oRefRangeAddress.EndRow = oSelRangeAddress.StartRow - 1
	
	sRefAbsoluteName = CellAddressString(oRefRangeAddress)
	
	'	Now use dispatch to copy and paste special
	
	rem ----------------------------------------------------------------------
	rem define variables
	dim document   as object
	dim dispatcher as object
	rem ----------------------------------------------------------------------
	rem get access to the document
	document   = ThisComponent.CurrentController.Frame
	dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
	
	rem ----------------------------------------------------------------------
	dim args1(0) as new com.sun.star.beans.PropertyValue
	args1(0).Name = "ToPoint"
	args1(0).Value = sRefAbsoluteName
	
	dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
	
	rem ----------------------------------------------------------------------
	dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())
	
	rem ----------------------------------------------------------------------
	dim args3(0) as new com.sun.star.beans.PropertyValue
	args3(0).Name = "ToPoint"
	args3(0).Value = sSelAbsoluteName
	
	dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args3())
	
	rem ----------------------------------------------------------------------
	dim args4(5) as new com.sun.star.beans.PropertyValue
	args4(0).Name = "Flags"
	args4(0).Value = "T"
	args4(1).Name = "FormulaCommand"
	args4(1).Value = 0
	args4(2).Name = "SkipEmptyCells"
	args4(2).Value = false
	args4(3).Name = "Transpose"
	args4(3).Value = false
	args4(4).Name = "AsLink"
	args4(4).Value = false
	args4(5).Name = "MoveMode"
	args4(5).Value = 6
	
	dispatcher.executeDispatch(document, ".uno:InsertContents", "", 0, args4())
End Sub

Function CellAddressString(oCellAddr as Object) as String
	
	Dim FuncService As Object

	'	Create service to access sheet functions
	FuncService = createunoservice("com.sun.star.sheet.FunctionAccess")
	
	CellAddressString = FuncService.CallFunction("ADDRESS", _
											array(oCellAddr.StartRow+1, _
											oCellAddr.StartColumn+1))
	
	If oCellAddr.EndRow > oCellAddr.StartRow Or oCellAddr.EndColumn > oCellAddr.StartColumn Then
		CellAddressString = CellAddressString _
							& ":" & FuncService.CallFunction("ADDRESS", _
							array(oCellAddr.EndRow+1, oCellAddr.EndColumn+1))
	End If									
End Function