Optimized macro to search backwards

[dandv]

I have a VB macro that searches backwards for the contents of the current cell(s). The problem is that in LibreCalc 5.2.0.1, it’s extremely slow. For example, it takes over 5 seconds to search about 4000 row on a Core i5 laptop. In excel, it’s instant.

Is there a way to optimize this macro or rewrite it in a different LO language?

Sub Search_cell_backwards()
' Search backwards (in the cells above) for all the cells that make up the current selection row
'
    With Selection
        For rw = .Row - 1 To 100 Step -1
            entireSelectionFound = 1
            For c = 1 To .Columns.Count
                If .Worksheet.Cells(rw, .Column + c - 1).Value <> .Cells(1, c).Value Then
                    entireSelectionFound = 0
                    Exit For
                End If
            Next c
            If entireSelectionFound = 1 Then
                .Worksheet.Range(.Worksheet.Cells(rw, .Column), .Worksheet.Cells(rw, .Column + .Columns.Count - 1)).Select
                Exit For
            End If
        Next rw
        If entireSelectionFound <> 1 Then
            MsgBox ("Couldn't find selection starting with: " & .Cells(1, 1).Value)
        End If
    End With
End Sub

[mark_t]

Is this an xls file with VBA? If you do not need to be compatible with excel you could change to a .ods file and rewrite your macro in LibreOffice basic.

You can optimize the existing VB to be slightly more efficient in both excel and calc:-

Try defining rw as long and c and entireSelectionFound as integer. Should be slightly faster in large number of iterations than default variant type.

Instead of evaluating the object properties each time you could declare a variable or object to get the property outside the for loop.

Sub Search_cell_backwards()
' Search backwards (in the cells above) for all the cells that make up the current selection row
'
    Dim rw As Long
    Dim c As Integer
    Dim entireSelectionFound As Integer
    Dim wks As Worksheet
    Dim colcnt As Integer
    Dim col As Integer

    With Selection
        Set wks = .Worksheet
        colcnt = .Columns.Count
        col = .Column

        For rw = .Row - 1 To 100 Step -1
            entireSelectionFound = 1
            For c = 1 To colcnt
                If wks.Cells(rw, col + c - 1).Value <> .Cells(1, c).Value Then
                    entireSelectionFound = 0
                    Exit For
                End If
            Next c
            If entireSelectionFound = 1 Then
                wks.Range(wks.Cells(rw, col), wks.Cells(rw, col + colcnt - 1)).Select
                Exit For
            End If
        Next rw
        If entireSelectionFound <> 1 Then
            MsgBox ("Couldn't find selection starting with: " & .Cells(1, 1).Value)
        End If
    End With
End Sub

It might also be faster to read all the cell values to an array and then search the array instead of the cells.

Excel returns a single variant instead of an array if only a single cell is in the range, I’m not trapping this condition in the example below so selecting a single cell will throw an error in this example.

Sub Search_cell_backwards()
' Search backwards (in the cells above) for all the cells that make up the current selection row
'
    Dim rw As Long
    Dim c As Integer
    Dim entireSelectionFound As Integer
    Dim wks As Worksheet
    Dim colcnt As Integer
    Dim col As Integer
    Dim vArr As Variant
    Dim vSel As Variant

    With Selection
        Set wks = .Worksheet
        colcnt = .Columns.Count
        col = .Column
        
        vSel = .Value
        vArr = wks.Range(wks.Cells(100, col), wks.Cells(.Row - 1, col + colcnt - 1)).Value
        
        For rw = UBound(vArr, 1) To 1 Step -1
            entireSelectionFound = 1
            For c = 1 To colcnt
                If vArr(rw, col + c - 1) <> vSel(1, c) Then
                    entireSelectionFound = 0
                    Exit For
                End If
            Next c
            
            If entireSelectionFound = 1 Then
                wks.Range(wks.Cells(rw + 100 - 1, col), wks.Cells(rw + 100 - 1, col + colcnt - 1)).Select
                Exit For
            End If
        Next rw
        If entireSelectionFound <> 1 Then
            MsgBox ("Couldn't find selection starting with: " & .Cells(1, 1).Value)
        End If
    End With
End Sub