Sub duplikati()

    If obojiDuplikate = True Then

        If obrisiDuplikate = False Then

            MsgBox "GRESKA! u brisanju duplikata"

            Stop

        End If

    Else

        MsgBox "GRESKA! u bojanju duplikata"

        Stop

    End If

End Sub

 

Function obojiDuplikate() As Boolean

    obojiDuplikate = False

   

    Dim LLoop As Long

    Dim LTestLoop As Long

    Dim LClearRange As String

    Dim Lrows As Long

    Dim Lcol As Long

    Dim LRange As String

 

    'A kolona, vrijednosti

    Dim LChangedValue As String

    Dim LTestValue As String

 

    'B kolona vrijednosti

    Dim LChangedValueB As String

    Dim LTestValueB As String

     

    With Application

        .Calculation = xlCalculationManual

        .ScreenUpdating = False

    End With

 

    'Lrows=zadnjiRed

    With ActiveSheet

        Lrows = .Cells(Rows.count, "A").End(xlUp).Row

        Lcol = .Cells(1, Columns.count).End(xlToLeft).Column

    End With

 

    LLoop = 2

 

    'obrisi boje ispune

    LClearRange = "A2:B" & Lrows

    Range(LClearRange).Interior.ColorIndex = xlNone

 

    'provjeri sve redove

    While LLoop <= Lrows

        LChangedValue = "A" & CStr(LLoop)

        LChangedValueB = "B" & CStr(LLoop)

        If Len(Range(LChangedValue).Value) > 0 Then

 

         'Nadi jedinstvenu vrijednost

         LTestLoop = 2

         While LTestLoop <= Lrows

            If LLoop <> LTestLoop Then

               LTestValue = "A" & CStr(LTestLoop)

               LTestValueB = "B" & CStr(LTestLoop)

               'vrijednost je duplikat u drugoj celiji

               If (Range(LChangedValue).Value = Range(LTestValue).Value) And (Range(LChangedValueB).Value = Range(LTestValueB).Value) Then

                  'postavi crvenu boju pozadine u A stupcu

                  Range(LChangedValue).Interior.ColorIndex = 3

                  Range(LTestValue).Interior.ColorIndex = 3

 

                  'postavi crvenu boju pozadine u B stupcu

                  'ovo netreba

                  Range(LChangedValueB).Interior.ColorIndex = 3

                  Range(LTestValueB).Interior.ColorIndex = 3

               End If

            End If

            LTestLoop = LTestLoop + 1

            Wend

        End If

        LLoop = LLoop + 1

    Wend

    obojiDuplikate = True

 

    With Application

        .Calculation = xlCalculationAutomatic

        .ScreenUpdating = True

    End With

 

End Function

 

Function obrisiDuplikate() As Boolean

    obrisiDuplikate = False

   

    Dim rCell As Range

    Dim rRange As Range

    Dim lCount As Long

     

 

    With Application

        .Calculation = xlCalculationManual

        .ScreenUpdating = False

    End With

 

    Set rRange = Range("A1", Range("A" & Rows.count).End(xlUp))

    lCount = rRange.Rows.count

     

    For lCount = lCount To 1 Step -1

        With rRange.Cells(lCount, 1)

            If WorksheetFunction.CountIf(rRange, .Value) > 1 Then

                .EntireRow.Delete

            End If

        End With

    Next lCount

    obrisiDuplikate = True

 

    With Application

        .Calculation = xlCalculationAutomatic

        .ScreenUpdating = True

    End With

 

End Function