Make a macro to sort a row using a custom list in LibreOffice Calc - sorting

Question

I need to sort a column containing cells with the following format : "TITLE text". I know the list of possible titles, but not the texts, so what I would like to do is sort the title in a custom order (for example : PLA, ARG, FHI, BRT) that is not alphabetical. The problem is that the title and the text are in the same cell.
So, for example, here is a screen of datas I might want to work on :
How can I sort this if the cells doesn't perfectly match the list members ?
And, if possible, how to do that using a macro and not manually ?

Answer 1

It's not very difficult. I will try to explain how this is done.
First of all, we need to figure out a way to transfer the range of cells to be sorted to the macro. There are different ways - write the address directly in the macro code, pass it as a parameter to the UDF, get it from the current selection. We use the third method - it is not the easiest to code, but it will work with any data sets.
The main difficulty when using the current selection is that the selection can be one single cell (nothing to sort), a range of cells (and may be several columns - how to sort this?) or several ranges of cells (this is if you hold down the CTRL key and select several unconnected ranges).
A good macro should handle each of these situations. But now we are not writing a good macro, we are getting acquainted with the principle of solving such problems (Since StackOfflow is a resource for programmers, the answers here help you write code yourself, and not get ready-made programs for free). Therefore, we will ignore a single cell and
multiple ranges - we will just stop execution of macro. Moreover, if there is more than one column in the selected range, then we will not do anything either.
Also, in case a full column is selected, we restrict the range to be sorted to the used area. This will sort the real data, but not the million empty cells.
The code that does all this looks like this:
Sub SortByTitles()
Dim oCurrentSelection As Variant
Dim oSortRange As Variant
Dim oSheet As Variant
Dim oCursor As Variant
Dim oDataArray As Variant
Dim sList As String
sList = "PLA,ARG,FHI,BRT"
oCurrentSelection = ThisComponent.getCurrentSelection()
Rem Is it one singl cell?
If oCurrentSelection.supportsService("com.sun.star.sheet.SheetCell") Then Exit Sub
Rem Is it several ranges of cells?
If oCurrentSelection.supportsService("com.sun.star.sheet.SheetCellRanges") Then Exit Sub
Rem Is this one range of cells? (It can be a graphic item or a control.
Rem Or it may not even be a Calc spreadsheet at all)
If Not oCurrentSelection.supportsService("com.sun.star.sheet.SheetCellRange") Then Exit Sub
Rem Is there only one column selected?
If oCurrentSelection.getColumns().getCount() <> 1 Then Exit Sub
Rem Is the current selection outside of the used area?
oSheet = oCurrentSelection.getSpreadsheet()
oCursor = oSheet.createCursor()
oCursor.gotoEndOfUsedArea(True)
oSortRange = oCursor.queryIntersection(oCurrentSelection.getRangeAddress())
If oSortRange.getCount() <> 1 Then Exit Sub
Rem Redim oSortRange as single range (not any ranges)
oSortRange = oSortRange.getByIndex(0)
Rem Get data from oSortRange
oDataArray = oSortRange.getDataArray()
Rem Paste sorted data to the same place:
oSortRange.setDataArray(getSorted(oDataArray, Split(sList,",")))
End Sub
The getSorted() function, which is mentioned in the last line of the procedure, must take two arrays as parameters — the values ​​of the cells to be sorted and the sort list — and return one array of sorted values.
One aspect of working with data from ranges of cells should be mentioned here. If in Excel after receiving data from the range we get a two-dimensional array, then in OpenOffice/LibreOffice we get a one-dimensional "array of arrays", each element of which is a one-dimensional array of cell values ​​of one row. Writing to a range is done from exactly the same structure, from an "array of arrays". The first parameter of the getSorted() function is oDataArray - just such an array of arrays, this will need to be taken into account when processing data.
What will getSorted() function do? It will build a "tree" sorted by Headers from the oDataArray values. In fact, this is not a tree - it is an ascending sorted array of all Headers and all values ​​with these Headers. The values ​​are also a sorted array. Then the function will select from the tree those Headings that are listed in the List and remove them from the tree. If, after all the actions, some elements still remain in the sorted tree, they will be displayed at the very end.
The function will accumulate the result in a separate array of the same size as the original one. In other words, the algorithm will use three times more memory than the original sorted range - source data, a tree and result array. The function will accumulate the result in a separate array of the same size as the original one. In other words, the algorithm will use three times more memory than the original sorted range - source data, a tree and result array.
You can try to save resources and write the results directly to the original array. But I strongly advise against doing this.
The fact is that an array cell may contain not a value, but a reference to a value, and in the case of inaccurate coding, you will not get a large sorted array, but a large array of the same value (the last cell).
I deliberately do not comment on all the following code - if you can read and understand this without comment, then you will understand how actions are programmed to process data from ranges:
Function getSorted(aData As Variant, aList As Variant) As Variant
Dim aRes As Variant
Dim i As Long, pos As Long, j As Long, k As Long, m As Long, uB As Long
Dim aTemp As Variant
aTemp = Array()
ReDim aRes(LBound(aData) To UBound(aData))
For i = LBound(aData) To UBound(aData)
pos = InStr(aData(i)(0), " ")
If pos > 0 Then
AddToArray(Left(aData(i)(0),pos-1), aData(i)(0), aTemp)
Else
AddToArray(aData(i)(0), aData(i)(0), aTemp)
EndIf
Next i
m = LBound(aData) - 1
For i = LBound(aList) To UBound(aList)
k = getIndex(aList(i), aTemp)
If k > -1 Then
uB = UBound(aTemp) - 1
For j = LBound(aTemp(k)(1)) To UBound(aTemp(k)(1))
m = m + 1
aRes(m) = Array(aTemp(k)(1)(j))
Next j
For j = k To uB
aTemp(j) = aTemp(j+1)
Next j
ReDim Preserve aTemp(uB)
EndIf
Next i
For k = LBound(aTemp) To UBound(aTemp)
For j = LBound(aTemp(k)(1)) To UBound(aTemp(k)(1))
m = m + 1
aRes(m) = Array(aTemp(k)(1)(j))
Next j
Next k
getSorted = aRes
End Function
To build a sorted tree, two subroutines are used - AddToArray() and InsertToArray(). They are very similar - the first eight lines are a normal binary search, and the remaining 10-12 lines are actions when an element is not found at the end of the array, when it is found and when it is not found in the middle of the array:
Sub AddToArray(key As Variant, value As Variant, aData As Variant)
Dim l&, r&, m&, N&, i&
l=LBound(aData)
r=UBound(aData)+1
N=r
While (l<r)
m=l+Int((r-l)/2)
If aData(m)(0)<key Then
l=m+1
Else
r=m
EndIf
Wend
If r=N Then
ReDim Preserve aData(0 To N)
aData(N) = Array(key, Array(value))
ElseIf aData(r)(0)=key Then
InsertToArray(value, aData(r)(1))
Else
ReDim Preserve aData(0 To N)
For i = N-1 To r Step -1
aData(i+1)=aData(i)
Next i
aData(r) = Array(key, Array(value))
EndIf
End Sub
Sub InsertToArray(key As Variant, aData As Variant)
Dim l&, r&, m&, N&, i&
l=LBound(aData)
r=UBound(aData)+1
N=r
While (l<r)
m=l+Int((r-l)/2)
If aData(m)<key Then
l=m+1
Else
r=m
EndIf
Wend
If r=N Then
ReDim Preserve aData(0 To N)
aData(N) = key
Else
ReDim Preserve aData(0 To N)
For i = N-1 To r Step -1
aData(i+1)=aData(i)
Next i
aData(r) = key
EndIf
End Sub
The getIndex() function uses the same binary search. It will return the index of the element in the array if it can find it, or -1 otherwise:
Function getIndex(key As Variant, aData As Variant) As Long
Dim l&, r&, m&, N&
l=LBound(aData)
r=UBound(aData)+1
N=r
While (l<r)
m=l+Int((r-l)/2)
If aData(m)(0)<key Then
l=m+1
Else
r=m
EndIf
Wend
If r=N Then
getIndex = -1
ElseIf aData(r)(0)=key Then
getIndex = r
Else
getIndex = -1
EndIf
End Function
And that's all that is needed to solve the task:
Demo file with code - SortByTitle.ods