REM  *****  BASIC  *****

REM Remove duplicates
Dim oDialog1 As Object, oDoc As Object, bInProgress As Boolean

Sub RemoveDuplicates
    oDoc = ThisComponent
    bInProgress = False

    Dim oController As Object, oSel As Object
    oController = oDoc.getCurrentController
    oSel = oDoc.getCurrentSelection()

    InitLanguage

    On Error GoTo errorExit
    If not oSel.supportsService("com.sun.star.sheet.SheetCellRange") then
        MsgBox getText(0) ' But other types of selection also possible, like frames, not only multiselection
        Err = 14 ' Invalid parameter
    End If

    Dim sourceAddress
    sourceAddress = oSel.getRangeAddress

    If oSel.supportsService("com.sun.star.sheet.SheetCell") then
        ExtendSingleSelection(oSel, oController)
    Else
        ClipSelectionToUsedArea(oSel, oController)
    End If
    On Error GoTo 0
    oSel = oDoc.getCurrentSelection()

    DialogLibraries.LoadLibrary("RemoveDuplicates")
    oDialog1 = CreateUnoDialog( DialogLibraries.RemoveDuplicates.Options )
    UpdateDialogUI
    cbIncludeTitle ' Take dialog-defined checked state into account
    If oDialog1.Execute() = 0 Then ' Cancel/error -> restore original selection
        oController.select(oSel.Spreadsheet.getCellRangeByPosition(sourceAddress.StartColumn, _
                                                                   sourceAddress.StartRow, _
                                                                   sourceAddress.EndColumn, _
                                                                   sourceAddress.EndRow))
    End If
errorExit:
End Sub

Sub UpdateDialogUI
    oDialog1.GetControl("OptionHint").Text = getText(5)
    oDialog1.GetControl("btnSelectAll").Label = getText(3)
    oDialog1.GetControl("cbTitle").Label = getText(4)
    oDialog1.GetControl("btnOK").Label = getText(6)
    oDialog1.GetControl("btnCancel").Label = getText(7)
End Sub

Sub UpdateListBoxItems (hasTitle As Boolean)
    Dim oSel, lbList
    oSel = oDoc.getCurrentSelection()
    lbList = oDialog1.GetControl("lbList")
    Dim ColDesc()
    If hasTitle Then
        Dim FirstRowRange As Object ' First row of selection
        FirstRowRange = oSel.getCellRangeByPosition(0, 0, oSel.Columns.Count - 1, 0)
        ColDesc = FirstRowRange.getDataArray()(0)
    Else
        Dim i As Long, sPrefix As String
        ColDesc = oSel.Columns.ElementNames
        sPrefix = getText(2)
        For i = lBound(ColDesc) To uBound(ColDesc)
            ColDesc(i) = sPrefix & ColDesc(i)
        Next i
    End If
    lbList.setVisible(False) ' this speeds up the update manyfold
    lbList.removeItems(0, lbList.getItemCount())
    lbList.addItems(ColDesc, 0)
    btnSelectAllClick
    lbList.setVisible(True)
End Sub

Sub ExtendSingleSelection(oSel As Object, oController As Object)
    Dim oCursor As Object
    oCursor = oSel.SpreadSheet.createCursorByRange(oSel)
    oCursor.collapseToCurrentRegion()
    If ((oCursor.Columns.Count = 1) And (oCursor.Rows.Count = 1)) Then
        MsgBox getText(1)
        Err = 14 ' Invalid parameter
    End If
    oController.select(oCursor)
End Sub

Sub ClipSelectionToUsedArea(oSel As Object, oController As Object)
    Dim cursor As Object, curAddr As Object, newAddr As Object, modified As Boolean
    newAddr = oSel.getRangeAddress
    modified = False
    cursor = oSel.SpreadSheet.createCursor()
    cursor.gotoStartOfUsedArea(False)
    curAddr = cursor.getRangeAddress()
    If (newAddr.StartColumn < curAddr.StartColumn) Then
        newAddr.StartColumn = curAddr.StartColumn
        modified = True
    End If
    If (newAddr.StartRow < curAddr.StartRow) Then
        newAddr.StartRow = curAddr.StartRow
        modified = True
    End If
    cursor.gotoEndOfUsedArea(False)
    curAddr = cursor.getRangeAddress()
    If (newAddr.EndColumn > curAddr.EndColumn) Then
        newAddr.EndColumn = curAddr.EndColumn
        modified = True
    End If
    If (newAddr.EndRow > curAddr.EndRow) Then
        newAddr.EndRow = curAddr.EndRow
        modified = True
    End If
    If ((newAddr.StartColumn > newAddr.EndColumn) Or _
        (newAddr.StartRow > newAddr.EndRow) Or _
        ((newAddr.StartColumn = newAddr.EndColumn) And _
         (newAddr.StartRow = newAddr.EndRow))) Then
        ' Selection outside of used area / collapsed to single cell -> Invalid parameter
        MsgBox getText(1)
        Err = 14
    End If
    If (modified) Then
        oController.select(oSel.Spreadsheet.getCellRangeByPosition(newAddr.StartColumn, _
                                                                   newAddr.StartRow, _
                                                                   newAddr.EndColumn, _
                                                                   newAddr.EndRow))
    End If
End Sub

Function CheckDup(rowStr As String, byRef UniqueColl)
    CheckDup = True
    On Error GoTo duplicateRow
    UniqueColl.Add(1, rowStr) ' Fails if exists
    CheckDup = False
duplicateRow:
End Function

Function GetCellRangeAddress(oSheet, StartColumn, StartRow, EndColumn, EndRow)
    Dim CellRangeAddress As New com.sun.star.table.CellRangeAddress
    CellRangeAddress.Sheet = oSheet.RangeAddress.Sheet
    CellRangeAddress.StartColumn = StartColumn
    CellRangeAddress.EndColumn = EndColumn
    CellRangeAddress.StartRow = StartRow
    CellRangeAddress.EndRow = EndRow
    GetCellRangeAddress = CellRangeAddress
End Function

Function GetCellAddress(oSheet, Column, Row)
    Dim CellAddress As New com.sun.star.table.CellAddress
    CellAddress.Sheet = oSheet.RangeAddress.Sheet
    CellAddress.Column = Column
    CellAddress.Row = Row
    GetCellAddress = CellAddress
End Function

Sub MoveCells(oSheet, StartColumn, StartRow, EndColumn, EndRow, NewRow)
    oSheet.copyRange(GetCellAddress(oSheet, StartColumn, NewRow), _
                     GetCellRangeAddress(oSheet, StartColumn, StartRow, EndColumn, EndRow))
End Sub

Sub RemoveCells(oSheet, left, top, right, bottom)
    oSheet.getCellRangeByPosition(left, top, right, bottom).clearContents(&HFFFFFFFF)
End Sub

Function GetRowString(aDataRow(), aCompInd()) As String
    Dim l As Long, u As Long
    l = lBound(aCompInd)
    u = uBound(aCompInd)
    If (l = u) Then ' Shortcut for performance
        GetRowString = aDataRow(aCompInd(l))
    Else
        Dim NewArr(l To u), i As Long
        For i = l To u
            NewArr(i) = aDataRow(aCompInd(i))
        Next i
        GetRowString = Join(NewArr, Chr(1))
    End If
End Function

' Returns 1 if successful, 0 otherwise
Function doRemove() As Long

    Dim StartTime As Date
    StartTime = Now()

    Dim bResult As Boolean, bModified As Boolean
    bResult = False
    bModified = False

    Dim oUndoManager As Object

    oDoc.lockControllers()
    oDoc.addActionLock()
    oUndoManager = ThisComponent.getUndoManager()
    oUndoManager.enterUndoContext("Remove Duplicates")
'   On Error GoTo cleanup

    Dim oSel As Object, oAddress As Object, aDataArray(), selectedLst(), bHasTitle As Boolean
    oSel = oDoc.getCurrentSelection()
    oAddress = oSel.getRangeAddress()
    aDataArray = oSel.getDataArray()

    selectedLst = oDialog1.GetControl("lbList").getSelectedItemsPos()
    bHasTitle = oDialog1.GetControl("cbTitle").getState() > 0

    Dim FirstRow As Long, LastRow As Long
    FirstRow = lBound(aDataArray)
    If bHasTitle Then
        FirstRow = FirstRow + 1
    End If
    LastRow = uBound(aDataArray)

    Dim ProgressBar As Object
    ProgressBar = oDialog1.GetControl("ProgressBar1")
    ResetProgress(ProgressBar, FirstRow, LastRow)

    Dim UniqueColl As New Collection, nDone As Long, Pos As Long
    nDone = FirstRow - 1
    For Pos = FirstRow To LastRow
        If (Not CheckDup(GetRowString(aDataArray(Pos), selectedLst), UniqueColl)) Then ' Unique
            nDone = nDone + 1
            If (nDone < Pos) Then aDataArray(nDone) = aDataArray(Pos)
        End If

        If ((Pos > 1) And (Pos Mod 100 = 0)) Then
            ' Check if cancelled
            If (Not bInProgress) Then Err = 18 ' Interrupted by user
            StepProgress(ProgressBar, 100)
        End If
    Next Pos

    If (nDone < LastRow) Then
        Dim nTop As Long, Bottom As Long
        nTop = FirstRow - lBound(aDataArray)
        nBottom = nDone - lBound(aDataArray)
        ReDim Preserve aDataArray(FirstRow To nDone)
        Dim oUniqueRange As Object
        oUniqueRange =  oSel.getCellRangeByPosition(0, _
                                                    nTop, _
                                                    uBound(aDataArray(nDone)) - lBound(aDataArray(nDone)), _
                                                    nBottom)
        oUniqueRange.setDataArray(aDataArray)
        RemoveCells(oSel.Spreadsheet, _
                    oAddress.StartColumn, _
                    oAddress.StartRow + nDone + 1, _
                    oAddress.EndColumn, _
                    oAddress.StartRow + LastRow)
    End If

    ' Make sure to set it to 100% before reporting success: it could not account yet for the last <100 elements
    SetProgress(ProgressBar, LastRow)

    bResult = True

cleanup:
    On Error Resume Next
    oUndoManager.leaveUndoContext()
    oDoc.removeActionLock()
    oDoc.unLockControllers()
    On Error GoTo 0

    Dim TotalCount As Long, DuplicatesCount As Long, Message As String
    Message = "Finished in " & Format((Now()-StartTime), "[s]") & " seconds." & Chr$(13)
    If (bResult) Then
        doRemove = 1
        TotalCount = LastRow - FirstRow + 1
        DuplicatesCount = LastRow - nDone
        If (DuplicatesCount > 0) Then
            Message = Message & "We found and deleted " & DuplicatesCount & " duplicated values." & Chr$(13) & _
                                "Now we have only " & TotalCount - DuplicatesCount & " unique vaues."
        Else
            Message = Message & "No duplicates found."
        End If
    Else
        doRemove = 0
        If (Err = 18) Then
            Message = Message & "Cancelled. "
        Else
            Message = Message & "An error occured! "
        End If
        If (bModified) Then
            Message = Message & "The changes will now be undone."
        Else
            Message = Message & "No changes have been made."
        End If
    End If
    MsgBox Message
    If (Not bResult And bModified) Then oUndoManager.Undo()
End Function

Sub ResetProgress(ByRef ProgressBar, nMinVal As Long, nMaxVal As Long)
    With ProgressBar
        .setRange(nMinVal, nMaxVal)
        .setValue(nMinVal)
    End With
End Sub

Sub SetProgress(ByRef ProgressBar, nVal As Long)
    ProgressBar.setValue(nVal)
End Sub

Sub StepProgress(ByRef ProgressBar, nStep As Long)
    With ProgressBar
        .setValue(.getValue() + nStep)
    End With
End Sub

Sub btnCancelClick
    If (bInProgress) Then
        oDialog1.GetControl("btnCancel").Enable = False ' Prevent second Cancel
        bInProgress = False
    Else
        oDialog1.endExecute()
    End If
End Sub

Sub btnOKClick
    bInProgress = True
    ' Only Cancel button is enabled in the process
    oDialog1.GetControl("btnSelectAll").Enable = False
    oDialog1.GetControl("cbTitle").Enable = False
    oDialog1.GetControl("btnOK").Enable = False
    oDialog1.GetControl("lbList").Enable = False
    oDialog1.endDialog(DoRemove())
End Sub

Sub btnSelectAllClick
    Dim lbList, count As Long, i As Long
    lbList = oDialog1.GetControl("lbList")
    count = lbList.getItemCount()
    Dim SelectItems(count) As Integer
    For i = 0 To count - 1
        SelectItems(i) = i
    Next i
    lbList.selectItemsPos(SelectItems, true)
End Sub

Sub cbIncludeTitle
    UpdateListBoxItems(oDialog1.GetControl("cbTitle").getState() > 0)
End Sub