Private Sub Remove_Dubs_IndBB()

Dim i As Long
Dim data As Integer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

data = Range("A2", Range("A" & Rows.Count).End(xlUp)).Count

Call Sum_IF
SendKeys ("{ESC}")

 With Range("A2", Range("F" & Rows.Count).End(xlUp))

 .Sort Key1:=Cells(1, 6), Order1:=xlDescending, _
 Header:=xlNo

    For i = 1 To data
        If (VBA.Date - Cells(i, 4)) / 365 > 5 Then
            Range(Cells(i, 1), Cells(i, 6)).ClearContents
        End If
        If (Cells(i, 5) - VBA.Date) / 365 < 1.25 Then
            Range(Cells(i, 1), Cells(i, 6)).ClearContents
        End If
     Next i

Range("A2", Range("F" & Rows.Count).End(xlUp).Address).Select
    Selection.Sort Key1:=Columns(6), Order1:=xlDescending, _
    Header:=xlNo

    Selection.Sort Key1:=Columns(2), Order1:=xlDescending _
    , Key2:=Columns(4), Order2:=xlDescending _
    , Key3:=Columns(5), Order3:=xlDescending _
    , Header:=xlNo


Range("A2", Range("F" & Rows.Count).End(xlUp)).RemoveDuplicates (3),        Header:=xlNo

 End With

 Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic

 End Sub

 Sub Sum_IF()

 Dim i As Long
 Dim data As Integer

data = Range("A2", Range("A" & Rows.Count).End(xlUp)).Count

 With Range("A2", Range("F" & data))
 For i = 1 To data
    .Cells(i, 6).FormulaR1C1 = "=SUMIF(R2C3:R[" & data & "]C3, RC[-3], R2C2:R[" & data & "]C2)"
    .Cells(i, 6).Copy
    .Cells(i, 6).PasteSpecial xlPasteValues
Next i
 End With

 End Sub