Delete entire column with duplicates in row 2

[emccracken]

I'm looking to delete duplicate columns based on the value in row 2. I have code that accomplishes this, but it deletes both the duplicate and the original. I need to keep one of the values. Here's what I have:

Option Explicit


Sub Row2Dups()


Dim rRow2 As Range
Dim aryRow2() As Long
Dim i As Long


    With ActiveSheet
        Set rRow2 = Range(.Cells(2, 1), .Cells(2, .Columns.Count).End(xlToLeft))
    End With
    
ReDim aryRow2(1 To rRow2.Columns.Count)


    For i = LBound(aryRow2) To UBound(aryRow2)
        aryRow2(i) = Application.WorksheetFunction.CountIf(rRow2, rRow2.Cells(1, i).Value)
    Next i
    
    For i = UBound(aryRow2) To LBound(aryRow2) Step -1
        If aryRow2(i) > 1 Then rRow2.Columns(i).EntireColumn.Delete
    Next i


End Sub

I have attached a sample file. The columns highlighted in blue are the duplicates. I need to delete ONE set of duplicates, and if you run my code, you'll see it deletes both.