vba - Add 1 day to todays date whenever value gets repeated

Question

I have a problem that I hope you can help me with.

The below code adds 1 day to todays day in Column B if it finds a repeated value in column A. However I want it to add 2 days if it gets repeated again and so on.

I have tried to illustrate how the codes work in the attached picture. So what I want is cell B10 in the picture to be 20/03/2021. I need to make it automatic so it can run for any number of repeated values.

Sub Add_date2()

    Dim lastRow As Long
    Dim matchFoundIndex As Long
    Dim iCntr As Long
    lastRow = Range("A65000").End(xlUp).Row

    For iCntr = 2 To lastRow
    
    If Cells(iCntr, 1) <> "" Then
        matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("A1:A" & lastRow), 0)
        
        If iCntr <> matchFoundIndex Then
            Cells(iCntr, 2) = Date + 1

        Else
            Cells(iCntr, 2) = Date
        End If
        
    End If
    
    Next
    
End Sub

Answer 1

Use Application.Countifs:

    Sub Add_date2()
    
        
        Dim ws As Worksheet
        Set ws = ActiveSheet 'better to set the actual sheet WorkSheets("Sheet1")
        
        With ws
            Dim lastRow As Long
            lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        
            Dim iCntr As Long
            For iCntr = 2 To lastRow
                If .Cells(iCntr, 1) <> "" Then
                    .Cells(iCntr, 2) = Date + Application.CountIfs(.Range(.Cells(2, 1), .Cells(iCntr, 1)), .Cells(iCntr, 1)) - 1
                End If
            Next
        End With
        
    End Sub