Dynamic Multi-Dimensional Array - Calc -Macro to How to Fillup Rows and Columns in Calc Document Sheet

English
, , ,
#1

Hi Friends,

I have recently seen “Trump Excel” Macro- VBA Code " Dynamic Multi-Dimensional Array " Copying the Data and Paste it- Row and Column wise

Here is the VBA-Code

Sub MultiArray()
Dim MultiArray()
Dim Dimension1 As Long, Dimension2 As Long
Dim NumberDimension1 As Long, NumberDimension2 As Long

NumberDimension1 = Range(“B2”, Range(“B2”).End(xlDown)).Cells.Count
NumberDimension2 = Range(“B2”, Range(“B2”).End(xlToRight)).Cells.Count

ReDim MultiArray(1 To NumberDimension1, 1 To NumberDimension2)

For Dimension1 = LBound(MultiArray, 1) To UBound(MultiArray, 1)
For Dimension2 = LBound(MultiArray, 2) To UBound(MultiArray, 2)
MultiArray(Dimension1, Dimension2) = Range(“B2”).Offset(Dimension1 - 1, Dimension2 - 1).Value
Next Dimension2
Next Dimension1

For Dimension1 = LBound(MultiArray, 1) To UBound(MultiArray, 1)
For Dimension2 = LBound(MultiArray, 2) To UBound(MultiArray, 2)
Range(“F2”).Offset(Dimension1 - 1, Dimension2 - 1).Value = MultiArray(Dimension1, Dimension2)
Next Dimension2
Next Dimension1

Erase MultiArray

End Sub

Can Anybody give me the Code Of…

  1. Exact Similar way of VBA Macros in LibreOffice Calc Marco with
    a) LibreOffice Calc_in the Same Document and Same Sheet
    b) LibreOffice Calc _Between TwoDifferent Documents

  2. How to do that Copy and Paste in ““Dynamic Multi-Dimensional Array”” in LibreOffice Calc Basic_Macro Code in
    a) LibreOffice Calc _Same Document and Same Sheet
    b) LibreOffice Calc _ Between Two Different Documents

Source Data Screen Shot

image
image1343×267 35.8 KB

After Running VBA Macro - Copy and Paste by Rows and Columns Screen Shot

image
image1336×253 58.3 KB

#2

Please delete the VBA code, mostly it is only for spleen. The description of your ask is better quiz than mostly liquidating IQ test with VBA code :-).

I hope I understood well to your problem. copyPasteData1 is for copy/paste raw data in one sheet → current active sheet.
For two documents you need open 2nd document (probably with the method oDoc2=StarDesktop.loadComponentFromUrl) and get the sheet in 2nd document like oSheet2=oDoc2.Sheets.getByName(…).
It is in copyPasteData2

Sub copyPasteData1 'copy raw data in current sheet
	dim oDoc as object, oSheet as object, oCur as object, oRange as object, p(), s$, data, i&, j&
	oDoc=ThisComponent
	oSheet=oDoc.CurrentController.ActiveSheet
	rem get data from input range
	data=getStartRange(oSheet, "B2").getDataArray() 'get range from initial cell to end of used cells
	rem set data to outpur range
	oRange=oSheet.getCellRangeByName("F2") '1st cell in output range
	i=oRange.RangeAddress.StartColumn : j=oRange.RangeAddress.StartRow 'start column, start row
	oRange=oSheet.getCellRangeByPosition(i, j, i+ubound(data(0)), j+ubound(data)) 'output range gotten from the size of data array
	oRange.setDataArray(data) 'write data
End Sub

Sub copyPasteData2 'copy raw data between two documents
	dim oDoc as object, oSheet as object, oCur as object, oRange as object, p(), s$, data, i&, j&, oDoc2 as object, oSheet2 as object
	oDoc=ThisComponent
	oSheet=oDoc.CurrentController.ActiveSheet
	const sUrl="d:\myDoc2.ods" 'your 2nd document
	oDoc2=StarDesktop.loadComponentFromUrl(ConvertToUrl(sUrl), "_blank", 0, array()) '2nd document
	oSheet2=oDoc2.Sheets.getByName("Sheet1") 'your sheet in 2nd document
	rem get data from input range
	data=getStartRange(oSheet, "B2").getDataArray() 'get range from initial cell to end of used cells
	rem set data to outpur range
	oRange=oSheet2.getCellRangeByName("F2") '1st cell in output range
	i=oRange.RangeAddress.StartColumn : j=oRange.RangeAddress.StartRow 'start column, start row
	oRange=oSheet2.getCellRangeByPosition(i, j, i+ubound(data(0)), j+ubound(data)) 'output range gotten from the size of data array
	oRange.setDataArray(data) 'write data
End Sub

Function getStartRange(oSheet as object, sCell$) as object 'get range from initial sCell to the end of used area in the sheet
	dim oCur as object, oRange as object
	oCur=oSheet.createCursor()
	oCur.goToEndOfUsedArea(false) 'cursor to the end of used area
	oRange=oSheet.getCellRangeByName(sCell) 'initial cell
	oRange=oSheet.getCellRangeByPosition(oRange.RangeAddress.StartColumn, oRange.RangeAddress.StartRow, oCur.RangeAddress.StartColumn, oCur.RangeAddress.StartRow)	'the range
	getStartRange=oRange
End Function
1 Like
How to Find Out in a Particular Column, Last Used Cell or No Of Rows through Macro ,which is Dynamically Increase or Decrease in a Data
#3

HI KamilLanda,

Thanks, Now I understand your above - “Code” ( Dynamic Multi-Dimensional Array )…

Now, I have another Scenario in the ( Dynamic Multi-Dimensional Array - " Multiple Data in the Same Sheet ")
that is
1) If the Sheet have " Multiple Data " and both have Dynamically Increase or Decrease. But I want Specifically “Only One Data” to Copy and Paste that one. How to that One…in LO-Calc BASIC Macro…?

Example: In the Below Screen Shot, I have the Three-Dummy-DATA , Both have Dynamically Increase or Decrease. I want Copy and Paste - Only One “Specific Data” Like “Countries - Population DATA”
a) If I run your above mentioned Code … The Last Used Area is “P35” Column P and Row 35, which is in “Inventory DATA” and did not get “F32” which is in “Countries - Population DATA”

Any Idea … Can you help me…

Here the Screen shot and Attached File
MyFile.ods (28.8 KB)

Note: For your Information For Screen Shot Purpose, I Used Three Dynamic Data into Very Near to EACH OTHER …

image
image1826×698 145 KB

#4

Hallo
please use →Data→Pivottable for that purpose

#5

Hi Karolus,

I need LibreOffice BASIC -Code…For Multiple Data which is Dynamically Expand or Decrease and Copy Specific DATA to Copy and Paste …

I know some little bit Alter this Code we can get that but… I am new to LO StarBasic Macro…

Below code for Single Data Which is Dynamically Expand or Decrease in the Sheet

============================================================
Sub copyPasteData1 'copy raw data in current sheet
	dim oDoc as object, oSheet as object, oCur as object, oRange as object, p(), s$, data, i&, j&
	oDoc=ThisComponent
	oSheet=oDoc.CurrentController.ActiveSheet
	rem get data from input range
	data=getStartRange(oSheet, "B2").getDataArray() 'get range from initial cell to end of used cells
	rem set data to outpur range
	oRange=oSheet.getCellRangeByName("F2") '1st cell in output range
	i=oRange.RangeAddress.StartColumn : j=oRange.RangeAddress.StartRow 'start column, start row
	oRange=oSheet.getCellRangeByPosition(i, j, i+ubound(data(0)), j+ubound(data)) 'output range gotten from the size of data array
	oRange.setDataArray(data) 'write data
End Sub

Sub copyPasteData2 'copy raw data between two documents
	dim oDoc as object, oSheet as object, oCur as object, oRange as object, p(), s$, data, i&, j&, oDoc2 as object, oSheet2 as object
	oDoc=ThisComponent
	oSheet=oDoc.CurrentController.ActiveSheet
	const sUrl="d:\myDoc2.ods" 'your 2nd document
	oDoc2=StarDesktop.loadComponentFromUrl(ConvertToUrl(sUrl), "_blank", 0, array()) '2nd document
	oSheet2=oDoc2.Sheets.getByName("Sheet1") 'your sheet in 2nd document
	rem get data from input range
	data=getStartRange(oSheet, "B2").getDataArray() 'get range from initial cell to end of used cells
	rem set data to outpur range
	oRange=oSheet2.getCellRangeByName("F2") '1st cell in output range
	i=oRange.RangeAddress.StartColumn : j=oRange.RangeAddress.StartRow 'start column, start row
	oRange=oSheet2.getCellRangeByPosition(i, j, i+ubound(data(0)), j+ubound(data)) 'output range gotten from the size of data array
	oRange.setDataArray(data) 'write data
End Sub

Function getStartRange(oSheet as object, sCell$) as object 'get range from initial sCell to the end of used area in the sheet
	dim oCur as object, oRange as object
	oCur=oSheet.createCursor()
	oCur.goToEndOfUsedArea(false) 'cursor to the end of used area
	oRange=oSheet.getCellRangeByName(sCell) 'initial cell
	oRange=oSheet.getCellRangeByPosition(oRange.RangeAddress.StartColumn, oRange.RangeAddress.StartRow, oCur.RangeAddress.StartColumn, oCur.RangeAddress.StartRow)	'the range
	getStartRange=oRange
End Function
#6

Your fancy »getStartRange« simplified:

Function getStartRange(oSheet as object, sCell$) as object 
    cell = oSheet.getCellRangeByName( sCell )
    cursor=oSheet.createCursorbyRange( cell )
    cursor.goToEndOfUsedArea(true) 
    getStartRange= cursor
End Function

and yes you show us howto (get|set)DataArray. (But we know already )

1 Like
#7

Why not cursor.collapseToCurrentRegion() ?

2 Likes
#8

Good question…so far I recall right, it didnt expand in some cases…? but I’ll test again!
Test done …collapseToCurrentRegion expands to local data Area with no gaps (empty Rows|Columns between) …goToEndOfUsedArea expands in any case from StartCell to the »last« available »not-empty-Cell«

1 Like
#9

… and so for the last example, where the range C16:F32 is required, goToEndOfUsedArea is not appropriate.

1 Like
#10

@JohnSUN Youre right … I did not put it in context to the given data :see_no_evil:

#11

I didn’t know the method collapseToCurrentRegion(), good advice from @JohnSun. This method subsumes whole Only One area, for example I want to get the range from C18 to the end of this one area, but it takes the range from C16. So I modify the getStartRange to get range from initial cell.
And because you use formatting (like Align to Center), I think the better solution is copy/paste with getTransferable/insertTransferable. It is slower, but it seems you don’t use some big data.

Sub copyPaste3 'copy/paste with formatting
	dim oDoc as object, oSheet as object, oCur as object, oRange1 as object, oRange2 as object, p(), s$, data, i&, j&
	oDoc=ThisComponent
	oSheet=oDoc.CurrentController.ActiveSheet
	rem get data from input range
	oRange1=getStartRange(oSheet, "C18") 'input range
	oDoc.CurrentController.Select(oRange1) 'select range from initial cell to end of used cells
	data=oDoc.CurrentController.getTransferable 'Copy
	rem set data to outpur range
	oRange2=oSheet.getCellRangeByName("D36") '1st cell in output range
	i=oRange2.RangeAddress.StartColumn : j=oRange2.RangeAddress.StartRow 'start column, start row
	oRange2=oSheet.getCellRangeByPosition(i, j, i+oRange1.RangeAddress.EndColumn-oRange1.RangeAddress.StartColumn, j+oRange1.RangeAddress.EndRow-oRange1.RangeAddress.StartRow) 'output range gotten from the size of input range
	oDoc.CurrentController.Select(oRange2) 'select output range
	oDoc.CurrentController.insertTransferable(data) 'Paste
End Sub

Function getStartRange(oSheet as object, sCell$) as object
 	dim oCur2 as object, oCur1 as object
 	oCur1=oSheet.getCellRangeByName(sCell) 'initial cell
    oCur2=oSheet.createCursorByRange(oCur1)
    oCur2.collapseToCurrentRegion() 'get all cells in range but no expand over empty cells (= Only One area)
    getStartRange=oSheet.getCellRangeByPosition(oCur1.CellAddress.Column, oCur1.CellAddress.Row, oCur2.RangeAddress.EndColumn, oCur2.RangeAddress.EndRow) 'range from sCell to the end of Only One area :-)
End Function

MyFile-kl1.ods (27.2 kB)

1 Like
#12

@KamilLanda
If you want to keep the formatting
sheet.copyRange( target.CellAddress , source.RangeAddress

2 Likes
#13

All right, with copyRange it is easier :slight_smile:

Sub copyPaste4 'copy/paste with formatting
	dim oDoc as object, oSheet as object, oRange as object, oCellAddress as new com.sun.star.table.CellAddress
	oDoc=ThisComponent
	oSheet=oDoc.CurrentController.ActiveSheet
	oRange=oSheet.getCellRangeByName("D36") 'get info for output cell
	with oCellAddress 'OUTPUT CELL (left top corner of output range)
		.Sheet=oSheet.RangeAddress.Sheet
		.Column=oRange.RangeAddress.StartColumn
		.Row=oRange.RangeAddress.StartRow
	end with
	oSheet.copyRange(oCellAddress, getStartRangeAddress(oSheet, "C18")) 'INITIAL CELL
End Sub

Function getStartRangeAddress(oSheet as object, sCell$) as object
 	dim oCur2 as object, oCur1 as object, oRange as object
 	oCur1=oSheet.getCellRangeByName(sCell) 'initial cell
    oCur2=oSheet.createCursorByRange(oCur1) 'range
    oCur2.collapseToCurrentRegion() 'get all cells in range but no expand over empty cells (= Only One area)
    oRange=oSheet.getCellRangeByPosition(oCur1.CellAddress.Column, oCur1.CellAddress.Row, oCur2.RangeAddress.EndColumn, oCur2.RangeAddress.EndRow) 'range from sCell to the end of Only One area :-)
    getStartRangeAddress=oRange.RangeAddress
End Function
1 Like
#14

You did it again, no need for casting, return oCur2.RangeAddress

1 Like
#15

Hi @karolus karolus,

“” karolus

@KamilLanda
If you want to keep the formatting
sheet.copyRange( target.CellAddress , source.RangeAddress “”

As per your above method… Its working ie Copy and Paste with Whatever Format…

But…
This Method… only Copy and Paste in the Same Calc Document with Same Sheet or Different Sheets.
that is Within Same Calc Document.

What about Copy and Paste - Two Different Calc Documents … that is Between Two Calc Documents.

As per @KamilLanda KamilLanda, She’s Code will Work both Same Calc Document As well As, Different Calc Documents…
Also , As per @JohnSUN, His Code will Work both Same Calc Document As well As, Different Calc Documents…

#16

But it returns all range, no the range from initial cell :-). For example I want to range from C18, and oCur2.RangeAddress returns the range from C16 although the initial cell is C18.

@sv.thiyagarajan
I thought you will compose the macro for 2 documents alone, because you had some own macros in the example :-). But OK, here it is.
It seems there have to be getTransferable/insertTranferable for copy between 2 documents.

Sub copyPaste5 'copy/paste with formatting
	dim oDoc1 as object, oDoc2 as object, oSheet1 as object, oSheet2 as object, oRange1 as object, oRange2 as object, data as object, sUrl2$, i&, j&
	oDoc1=ThisComponent
	oSheet1=oDoc1.CurrentController.ActiveSheet
	sUrl2="private:factory/scalc" 'new spreadsheet
	'sUrl2="d:\myfile2.ods" 'your 2nd document
	oDoc2=StarDesktop.loadComponentFromUrl(ConvertToUrl(sUrl2), "_blank", 0, array() )
	oSheet2=oDoc2.Sheets(0) '1st sheet; or for example oSheet2=oDoc.Sheets.getyByName("Sheet1")  'by sheet name

	rem Copy data from input range
	oRange1=getStartRange(oSheet1, "C18") 'input range
	oDoc1.CurrentController.Select(oRange1) 'select range from initial cell to end of used cells
	data=oDoc1.CurrentController.getTransferable 'Copy

	rem Paste data to outpur range
	oRange2=oSheet2.getCellRangeByName("D36") '1st cell in output range
	i=oRange2.RangeAddress.StartColumn : j=oRange2.RangeAddress.StartRow 'start column, start row
	oRange2=oSheet2.getCellRangeByPosition(i, j, i+oRange1.RangeAddress.EndColumn-oRange1.RangeAddress.StartColumn, j+oRange1.RangeAddress.EndRow-oRange1.RangeAddress.StartRow) 'output range gotten from the size of input range
	oDoc2.CurrentController.Select(oRange2) 'select output range
	oDoc2.CurrentController.insertTransferable(data) 'Paste
End Sub

Function getStartRange(oSheet as object, sCell$) as object 'get range from initial cell sCell to the end of one area
 	dim oCur2 as object, oCur1 as object
 	oCur1=oSheet.getCellRangeByName(sCell) 'initial cell
    oCur2=oSheet.createCursorByRange(oCur1)
    oCur2.collapseToCurrentRegion() 'get all cells in range but no expand over empty cells (= Only One area)
    getStartRange=oSheet.getCellRangeByPosition(oCur1.CellAddress.Column, oCur1.CellAddress.Row, oCur2.RangeAddress.EndColumn, oCur2.RangeAddress.EndRow) 'range from sCell to the end of Only One area :-)
End Function
1 Like
#17

Hi @KamilLanda KamilLanda,

As you mentioned in the earlier post … your comment…

" getTransferable and InsertTransferable " -Method … Slower when using Big Data…in Calc Document …Did you test that one…?

#18

Yes, I use this method in a projects often. It is “internal LibreOffice CtrlC+V”. Classical CtrlCV via system clipboard isn’t trusted for usage with macros, so there is the method getTransferable/insertTransferable. It is also well applicable to transfer data between Calc and Writer.
With the term big data I mean the thousands rows&columns with very various formatting like the colours and sounds in a gaggle of many parrots :-). I suppose you tested last examples and there wasn’t problem with speed.
And the improvements exists, turn off the Autocalculate and Stop screen rendering during copy/paste.

Sub copyPaste6 'copy/paste with formatting
	dim oDoc1 as object, oDoc2 as object, oSheet1 as object, oSheet2 as object, oRange1 as object, oRange2 as object, data as object, sUrl2$, i&, j&
	dim bAct1 as boolean, bAct2 as boolean
	oDoc1=ThisComponent
	oSheet1=oDoc1.CurrentController.ActiveSheet
	
	bAct1=oDoc1.isAutomaticCalculationEnabled() 'the current value of Automatic calculation
	oDoc1.lockControllers() 'no screen actualization
	oDoc1.addActionLock() 'turn off the Autocalculate
	
	sUrl2="private:factory/scalc" 'new spreadsheet
	'sUrl2="d:\myfile2.ods" 'your 2nd document
	oDoc2=StarDesktop.loadComponentFromUrl(ConvertToUrl(sUrl2), "_blank", 0, array() )
	oSheet2=oDoc2.Sheets(0) '1st sheet; or for example oSheet2=oDoc.Sheets.getyByName("Sheet1")  'by sheet name
	
	bAct2=oDoc2.isAutomaticCalculationEnabled() 'the current value of Automatic calculation
	oDoc2.lockControllers() 'no screen rendering
	oDoc2.addActionLock() 'disable Autocalculate

	rem Copy data from input range
	oRange1=getStartRange(oSheet1, "C18") 'input range
	oDoc1.CurrentController.Select(oRange1) 'select range from initial cell to end of used cells
	data=oDoc1.CurrentController.getTransferable 'Copy

	rem Paste data to outpur range
	oRange2=oSheet2.getCellRangeByName("D36") '1st cell in output range
	i=oRange2.RangeAddress.StartColumn : j=oRange2.RangeAddress.StartRow 'start column, start row
	oRange2=oSheet2.getCellRangeByPosition(i, j, i+oRange1.RangeAddress.EndColumn-oRange1.RangeAddress.StartColumn, j+oRange1.RangeAddress.EndRow-oRange1.RangeAddress.StartRow) 'output range gotten from the size of input range
	oDoc2.CurrentController.Select(oRange2) 'select output range
	oDoc2.CurrentController.insertTransferable(data) 'Paste
	
	oDoc1.removeActionLock() 'enable Autocalculate
	oDoc1.unlockControllers() 'enable screen rendering
	oDoc1.enableAutomaticCalculation(bAct1) 'primal set of Autocalculate
	
	oDoc2.removeActionLock() 'enable Autocalculate
	oDoc2.unlockControllers() 'enable screen rendering
	oDoc2.enableAutomaticCalculation(bAct2) 'primal set of Autocalculate
End Sub

Function getStartRange(oSheet as object, sCell$) as object 'get range from initial cell sCell to the end of one area
 	dim oCur2 as object, oCur1 as object
 	oCur1=oSheet.getCellRangeByName(sCell) 'initial cell
    oCur2=oSheet.createCursorByRange(oCur1)
    oCur2.collapseToCurrentRegion() 'get all cells in range but no expand over empty cells (= Only One area)
    getStartRange=oSheet.getCellRangeByPosition(oCur1.CellAddress.Column, oCur1.CellAddress.Row, oCur2.RangeAddress.EndColumn, oCur2.RangeAddress.EndRow) 'range from sCell to the end of current area
End Function

If you want to automatize copy of many tables, then it is also possible to add the Progressbar.

1 Like

Impressum (Legal Info) | Datenschutzerklärung (Privacy Policy)   Content on this site is licensed under a Creative Commons Attribution Share Alike 3.0 license.