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

REM Remove duplicates
Dim oDialog1 As Object, oDoc As Object, oController As Object, oSheet As Object

Sub RemoveDuplicates
    oDoc = ThisComponent
    oController = oDoc.getCurrentController
    oSheet = oController.activeSheet

    Dim oSel As Object, oRange As Object
    oSel = oDoc.getCurrentSelection()

    InitLanguage

    If not oSel.supportsService("com.sun.star.sheet.SheetCellRange") then
        MsgBox getText(0)
        Exit sub
    End If

    Dim sourceAddress
    sourceAddress = oSel.getRangeAddress

    If oSel.supportsService("com.sun.star.sheet.SheetCell") then
        ExtendSingleSelection(oSel)
        oSel = oDoc.getCurrentSelection()
    Else
        Dim cursor As Object, endAddr As Object, newAddr As Object, modified As Boolean
        cursor = oSheet.createCursor()
        cursor.gotoEndOfUsedArea(False)
        endAddr = cursor.getRangeAddress()
        newAddr = sourceAddress
        modified = False
        If (newAddr.EndColumn > endAddr.EndColumn) Then
            newAddr.EndColumn = endAddr.EndColumn
            modified = True
        End If
        If (newAddr.EndRow > endAddr.EndRow) Then
            newAddr.EndRow = endAddr.EndRow
            modified = True
        End If
        If (modified) Then
            oRange = oSheet.getCellRangeByPosition(newAddr.StartColumn, newAddr.StartRow, newAddr.EndColumn, newAddr.EndRow)
            oController.select(oRange)
            oSel = oDoc.getCurrentSelection()
        End If
    End If

    If oSel.supportsService("com.sun.star.sheet.SheetCell") then
        MsgBox getText(1)
        Exit Sub
    End If

    ' Do not allow selecting the whole sheet: it would simply be too long ("hang")
    ' In the future, the max column coult may be increased - use ">=" here
    If ((oSel.Columns.Count >= 1024) And (oSel.Rows.Count = 1024*1024)) Then
        MsgBox "The whole sheet selected; this will hang the operation - aborting"
        Exit Sub
    End If

    DialogLibraries.LoadLibrary("RemoveDuplicates")
    oDialog1 = CreateUnoDialog( DialogLibraries.RemoveDuplicates.Options )
    UpdateDialogUI
    cbIncludeTitle
    If oDialog1.Execute() = 0 Then
        oRange = oSheet.getCellRangeByPosition(sourceAddress.StartColumn, sourceAddress.StartRow, sourceAddress.EndColumn, sourceAddress.EndRow)
        oController.select(oRange)
    End If
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)
Dim oCursor
    oCursor = oSel.SpreadSheet.createCursorByRange(oSel)
    oCursor.collapseToCurrentRegion
    oController.select(oCursor)
End Sub

Function CheckInArray(checkRow As String, byRef UnionArray)
    CheckInArray = True
    On Error GoTo duplicateRow
    UnionArray.Add(1, checkRow) ' Fails if exists
    CheckInArray = False
duplicateRow:
End Function

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

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

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

Sub RemoveCells(Sheet, StartColumn, StartRow, EndColumn, EndRow)
    oSheet.removeRange(GetCellRangeAddress(Sheet, StartColumn, StartRow, EndColumn, EndRow), _
                       com.sun.star.sheet.CellDeleteMode.UP)
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
        GetRowString = aDataRow(aCompInd(l))
        Exit Function
    End If
    Dim NewArr(l To u), i As Long
    For i = lBound(aCompInd) To uBound(aCompInd)
        NewArr(i) = aDataRow(aCompInd(i))
    Next i
    GetRowString = Join(NewArr, Chr(1))
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 UnionArray As New Collection, LastRowDone As Long, nUnique As Long, Pos As Long, checkStr As String
    LastRowDone = FirstRow - 1
    nUnique = 0
    For Pos = FirstRow To LastRow
        checkStr = GetRowString(aDataArray(Pos), selectedLst)
        If (CheckInArray(checkStr, UnionArray)) Then ' Duplicate
            If (nUnique > 0) Then
                If (nUnique < (Pos - FirstRow)) Then
                    MoveCells(oAddress.Sheet, _
                              oAddress.StartColumn, _
                              oAddress.StartRow + Pos - nUnique, _
                              oAddress.EndColumn, _
                              oAddress.StartRow + Pos - 1, _
                              oAddress.StartRow + LastRowDone + 1)
                    bModified = True
                End If
                LastRowDone = LastRowDone + nUnique
                nUnique = 0
            End If
        Else ' Unique
            nUnique = nUnique + 1
        End If

        If ((Pos > FirstRow) And (Pos Mod 100 = 0)) Then
            StepProgress(ProgressBar, 100)
        End If
    Next Pos

    If (nUnique > 0) Then
        If (nUnique < (Pos - FirstRow)) Then
            MoveCells(oAddress.Sheet, _
                      oAddress.StartColumn, _
                      oAddress.StartRow + Pos - nUnique, _
                      oAddress.EndColumn, _
                      oAddress.StartRow + Pos - 1, _
                      oAddress.StartRow + LastRowDone + 1)
            bModified = True
        End If
        LastRowDone = LastRowDone + nUnique
    End If

    If (LastRowDone < LastRow) Then
        RemoveCells(oAddress.Sheet, _
                    oAddress.StartColumn, _
                    oAddress.StartRow + LastRowDone + 1, _
                    oAddress.EndColumn, _
                    oAddress.StartRow + LastRow)
        bModified = True
    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:
    oUndoManager.leaveUndoContext()
    oDoc.unLockControllers()
    oDoc.removeActionLock()

    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 - LastRowDone
        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 (bModified) Then
            Message = Message & "An error occured! The changes will now be undone."
        Else
            Message = Message & "An error occured! 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
    oDialog1.endExecute()
End Sub

Sub btnOKClick
    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
    Dim cbTitle
    cbTitle = oDialog1.GetControl("cbTitle")
    If cbTitle.getState() > 0 Then
        UpdateListBoxItems(True)
    Else
        UpdateListBoxItems(False)
    End If
End Sub