Sub RemoveDuplicates()

Application.ScreenUpdating = False

Dim LR As Long, i As Long
Dim AcctSearchRange As Range
Dim AcctFindRange As Range, C As Range, Cel As Range, D As Range
Dim AcctValueToFind As Variant
Dim SubValueToFind As Variant
Dim CurrentSheet As Worksheet
Dim xlSheet As Worksheet, Xfound As Boolean
Dim firstAddress  As String


Set CurrentSheet = ActiveWorkbook.ActiveSheet
Set xlSheet = ActiveWorkbook.Worksheets("CurrentBSCOA")
Set AcctSearchRange = xlSheet.Range("E1:E" & xlSheet.Range("E" & Rows.Count).End(xlUp).Row)
Set AcctFindRange = CurrentSheet.Range("C1:C" & CurrentSheet.Range("C" & Rows.Count).End(xlUp).Row)


LR = Range("A" & Rows.Count).End(xlUp).Row

Range("A" & Rows.Count).End(xlUp).Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlYes, Key2:=Range("D1"), Order2:=xlAscending, Header:=xlYes, Key3:=Range("E1"), Order3:=xlAscending, Header:=xlYes
For i = LR To 1 Step -1
   ***If (Range("C" & i) = Range("C" & i - 1) And Range("D" & i) = Range("D" & i - 1)) Then Rows(i).Delete***
Next i
Range("A" & Rows.Count).End(xlUp).Sort Key1:=Range("C1"),  Order1:=xlAscending, Header:=xlYes, Key2:=Range("D1"), Order2:=xlAscending, Header:=xlYes, Key3:=Range("E1"), Order3:=xlAscending, Header:=xlYes