Muzan
Muzan

Reputation: 15

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

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 : Example of datas already sorted

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 ?

Upvotes: 0

Views: 1970

Answers (1)

JohnSUN
JohnSUN

Reputation: 2539

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:

Small demo SortByTitle.gif

Demo file with code - SortByTitle.ods

Upvotes: 1

Related Questions