Delete the first 7 days data from column B

Hi friends

I have the below code which paste all the data in file 1 after comparison of 2 sheets, now I need is to check the date range from B1 and also range R, if the top range is within 7 days of date range delete the rows till 7th day and the new 7th day range is copied at the bottom of file 1 sheet1.

Option Explicit
Sub CompareFiles()

Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, wsUnique As Worksheet, ws2 As Worksheet
Dim rng1 As Range, rng2 As Range, c As Range
Dim arr1, arr2
Dim a, TotRws As Long, i As Long, delcount As Long, val As String
Dim Found As Boolean
Dim Lastrow As Long

Set wb1 = Workbooks.Open(Filename:="file1.xlsx")
        Set ws1 = wb1.Worksheets("Sheet1") 'change to suit or use wb1.Worksheets("Name of Sheet")

On Error Resume Next
'if workbook is not open this will throw an error
Set wb2 = Workbooks("file2.xlsx")  'change

'if error is thrown then we will open the workbook
If Err.Number > 0 Then
    Err.Clear

    Set wb2 = Workbooks.Open(Filename:="file2.xlsx")
    
End If

Set ws2 = wb2.Sheets(1)  'change to suit

Set rng1 = ws1.Range("R4", ws1.Range("R" & Rows.Count).End(xlUp))   'dynamic range...you don't have to know what the last cell is it starts at two assuming there is a header
Set rng2 = ws2.Range("R4", ws2.Range("R" & Rows.Count).End(xlUp))  'dynamic range for file2

arr1 = rng1.Value  'populate array with range
arr2 = rng2.Value

TotRws = rng2.Rows.Count

delcount = 0
Application.ScreenUpdating = False
'loop for each value in the range on file 1 see if that value matches a value in file two if so delete the row

    For i = UBound(arr2, 1) To LBound(arr2, 1) Step -1
        For Each a In arr1
            Debug.Print a
            Debug.Print arr2(i, 1)
            
            If a = arr2(i, 1) Then
                With ws2
                    Range("R" & i + 1).EntireRow.Delete
                    delcount = delcount + 1
                    Exit For
                End With
            End If

        Next a
    Next i

'Check for unique values
If delcount = TotRws Then
    MsgBox "No Unique Values"
    Exit Sub
End If

'reset rng2 to the new range without the deleted rows (aka unique values)
    Set rng2 = ws2.Range("A4:AN" & ws2.Range("R" & Rows.Count).End(xlUp).Row)
    On Error Resume Next
    'assuming you run the code multiple times
    'Set wsUnique = wb1.Worksheets("Unique Values")
    'If Err.Number > 0 Then
        'Err.Clear
        'Set wsUnique = wb1.Sheets.Add(After:=Worksheets(Worksheets.Count))
       'wsUnique.Name = "Unique Values"
    'End If
    
'recount the total rows
rng2.Copy Destination:=wb1.Worksheets("Sheet1").Range("A:AN" & Cells(Rows.Count, "A").End(xlUp).Row)

'place unique values in the new sheet
With Application
    .ScreenUpdating = False
    .CutCopyMode = xlCopy
End With

End Sub

Thanks in advance