Macro to Swap cell contents

This may sound familiar but swap the contents of two cells are not possible. Although, to swap two cells, there is an option suggested (ALT + DRAG) which actually use “paste special (with down option)”.

In Microsoft Excel, I used to perform it with following combinations.

1) Select the first cell > cut (Command + x) 
2) Select the second cell > swap (Command + i) 

Upon disappointment to achieve it in LibreOffice, I tried to record and edit a macro (Please allow me to admit that I have no prior experience in writing macros).

All I’m trying to achieve is to swap the contents of two selected cells.

The result I’m trying to achieve is as follows.

1) Select two cells
2) Run Macro (preferably with shortcut: Command + i)

---- Macro Begins

1) Copy the selected cells (take references of selected cells: A - B).
2) Paste it on the bottom right corner of the spreadsheet (To avoid any chance of loosing data)
   // The cells will be pasted as on top of each other
   // Rather pasting it at the end of the sheet, if the values are retained in a variable, it will be more than good.
3) Copy and paste the bottom cell (B) on the reference of (A)
4) Copy and paste the top cell  (A) on the reference of (B)

I’ve already wasted many hours now and I’d seriously appreciate if someone could do it.

Important: You need select two cells.

Sub swap_values()

	doc = ThisComponent
	sel = doc.CurrentSelection
	
	If sel(0).ImplementationName = "ScCellObj" Then
		c1 = sel(0)
		c2 = sel(1)
	Else
		If sel(0).Columns.Count = 2 Then
			c1 = sel(0).getCellByPosition(0,0)
			c2 = sel(0).getCellByPosition(1,0)
		Else
			c1 = sel(0).getCellByPosition(0,0)
			c2 = sel(0).getCellByPosition(0,1)		
		End If
	End If
	
	tmp = c1.String
	c1.String = c2.String
	c2.String = tmp

End Sub

image description

if someone used Python, like me, soo…

doc = XSCRIPTCONTEXT.getDocument()
sel = doc.CurrentSelection

if sel.ImplementationName == 'ScCellRangesObj':
    c1 = sel[0]
    c2 = sel[1]
else:
    c1 = sel[0][0,0]
    if len(sel[0].Columns) == 2:
        c2 = sel[0][0,1]
    else:
        c2 = sel[1][0,0]

c1.String, c2.String = c2.String, c1.String

It gives me an error:

BASIC runtime error.
Property or method not found: String.

Select you two cells, before?

Ok @mauricio, perfect very simply, congratulations!

Just select two consecutive cells in a row or in a column. It shows an error. Because selecting two consecutive cells produces single range.

Please make it handle if the selection produces single range. I’ll accept your answer.

Thanks for the video, wish I had experimented the same. I would have saved a lot of time.

Thanks. I accept your answer for being tidier though I have achieved the same with my script some time ago.

There is an error in your python implementation. It throws an error on string comparison operator.

You can’t execute code Python into IDE Basic. Look: Macros/Python Guide - The Document Foundation Wiki

Great. Congrats for a tider script. :+1:

@navshah,

Getting information from two selected cells, I do not know the procedure. I did informing the cells manually.

Select the first cell of the swap, and trigger the macro.

    Sub Exchange
'================================================|
Dim oActiveCell
Dim oConv
    oActiveCell = ThisComponent.getCurrentSelection()
    If oActiveCell.ImplementationName <> "ScCellObj" Then
       Msgbox "Please select an individual cell!", 48,"Warning"       
    Exit Sub
    End If
    oConv = ThisComponent.createInstance("com.sun.star.table.CellAddressConversion")
    oConv.Address = oActiveCell.getCellAddress
    Var1 = oConv.UserInterfaceRepresentation
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint" : args1(0).Value = Var1
createUnoService("com.sun.star.frame.DispatchHelper") _
.executeDispatch(ThisComponent.CurrentController.Frame, ".uno:GoToCell", "", 0, args1())
Dim oSel as Object
oSel = ThisComponent.getCurrentSelection()
Var1A = oSel.getString()

Dim Cell As String
Cell = InputBox("Second cell ?")
Var2 = Cell
dim args2(0) as new com.sun.star.beans.PropertyValue
args2(0).Name = "ToPoint" : args2(0).Value = Var2
createUnoService("com.sun.star.frame.DispatchHelper") _
.executeDispatch(ThisComponent.CurrentController.Frame, ".uno:GoToCell", "", 0, args2())
oSel = ThisComponent.getCurrentSelection()
Var2A = oSel.getString()

dim args3(0) as new com.sun.star.beans.PropertyValue
args3(0).Name = "StringName" : args3(0).Value = Var1A
createUnoService("com.sun.star.frame.DispatchHelper") _
.executeDispatch(ThisComponent.CurrentController.Frame, ".uno:EnterString", "", 0, args3())

dim args4(0) as new com.sun.star.beans.PropertyValue
args4(0).Name = "ToPoint" : args4(0).Value = Var1
createUnoService("com.sun.star.frame.DispatchHelper") _
.executeDispatch(ThisComponent.CurrentController.Frame, ".uno:GoToCell", "", 0, args4())
dim args5(0) as new com.sun.star.beans.PropertyValue
args5(0).Name = "StringName" : args5(0).Value = Var2A
createUnoService("com.sun.star.frame.DispatchHelper") _
.executeDispatch(ThisComponent.CurrentController.Frame, ".uno:EnterString", "", 0, args5())
End Sub

ATTENTION: If you would like to give more details to your question, use edit in question or add a comment below. Thank you.

If the answer met your need, please click on the ball Descrição da imagem to the left of the answer, to finish the question.

It’s half done. I have to mention the cell position in the dialog. It’s a bit inconvenient but I will accept it as answer if I didn’t get any better answer.

Thank you everyone for their kind contribution however I finally ended up with what I was looking for.
The script has a limitation that if it’s used on two different ranges, it crashes. Some try-catch can fix that but I’m exhausted now.

Next step is to assign a shortcut to it :expressionless:

Sub Swap()

Dim selection as Object
selection = ThisComponent.getCurrentSelection()

cell1Address = ThisComponent.createInstance("com.sun.star.table.CellRangeAddressConversion")
cell2Address = ThisComponent.createInstance("com.sun.star.table.CellRangeAddressConversion")

cell1Address.Address = selection(0).getRangeAddress	
cell2Address.Address = selection(1).getRangeAddress

cell1 = cell1Address.UserInterfaceRepresentation
cell2 = cell2Address.UserInterfaceRepresentation

REM if the cells are in contagious single range
If selection.supportsService("com.sun.star.sheet.SheetCellRange") Then
    
	arr = Split(cell1, ":")
	cell1 = arr(0)
	cell2 = arr(1)
    
End If


REM // Get the cell references to write values

cellA = ThisComponent.Sheets(0).getCellRangebyName(cell1)
cellB = ThisComponent.Sheets(0).getCellRangebyName(cell2)

REM // Store CellA values temporarily in a string variable 't'

Dim t as String
t = cellA.String

cellA.String = cellB.String
cellB.String = t



End Sub

By casual coincidence I recently created user code and a demo concerning the topic but using a different approach.
See this attached Calc document. The swap will include formats and all.

===Edit 2019-11-08 23:40 UTC===
Just did another test with the above attached example and found an error: A pair of parentheses was missing.
In addition I had to state that the code did not allow to use two adjacent cells.
Insertion of the parentheses rectified the first error.
To make the code also work with two adjacent cells for swapping, it was necessary to go a bit deeper: One of the cell needs to be deselected again, but left keeping the focus to enforce the needed difference. The code needed to be completed with a conditional statement block calling a function for getting the cell with focus if needed.
You find the reworked code here: swapRanges_rectified.ods.