Deleting Rows where Column A contains a date before...

[plfas]

So I've got a lot of help on these boards, but I need some more.

I import some raw survey response data on the first two sheets, named English and French respectively. My current macro splits the timestamp in column "A" into separate date and time columns. It then deletes surveys abandoned on the first question and adds some NPS calculations in columns S and T.

The raw data for the responses comes from the entire time period the survey has been running. What I need to do is turn this into a weekly report.

In an ideal world, the user would be prompted to enter a start and end date for the report. It would then delete the entire row that contains dates in column A outside of that range.

I don't know this is possible, as my "Master" macro that calls this sub routine turns off screen updating, display alerts and automatic calculation. Otherwise, my code takes literally 30 minutes to run.

In a less ideal world, it would simply delete all responses (rows) that are more than a week old.


Here is my code that runs on the "raw data" sheets:

Sub SplitDate()



    Dim wrkSht As Worksheet
    Dim i As Long
    
    For Each wrkSht In ThisWorkbook.Worksheets
        If wrkSht.Name = "English" Or wrkSht.Name = "French" Then
            With wrkSht




                '
                ' Splits Date & Time into two columns
                '
                    .Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
                    .Range("A:A").TextToColumns Destination:=.Range("A:A"), DataType:=xlDelimited, _
                        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
                        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
                        :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
                    
                'Deletes responses abandoned on first question
                
                
                Dim LastRow As Long
                LastRow = .Range("A65536").End(xlUp).Row
                
                For i = LastRow To 1 Step -1
                If .Cells(i, 6) = "Abandoned" Then .Rows(i & ":" & i).EntireRow.Delete
                Application.ScreenUpdating = False
                Next i
                
                
                '' Adds Promoters,Detractors, etc to columns t/u
                
                
                Dim endrow As Long
                endrow = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
                                
                .Range("S3").FormulaR1C1 = _
                        "=IF(RC[-12]=""Unattempted"",""N/A"",IF(RC[-12]=""Abandoned"",""N/a"",IF(RC[-12]>8,""Promoter"",IF(RC[-12]>6,""Passive"",""Detractor""))))"
                .Range("S3").AutoFill Destination:=.Range("S3:S" & endrow), Type:=xlFillDefault
                
                .Range("T3").FormulaR1C1 = _
                        "=IF(RC[-9]=""Unattempted"",""N/A"",IF(RC[-9]=""Abandoned"",""N/a"",IF(RC[-9]>8,""Promoter"",IF(RC[-9]>6,""Passive"",""Detractor""))))"
                .Range("T3").AutoFill Destination:=.Range("T3:T" & endrow), Type:=xlFillDefault
            End With
        End If




    Next wrkSht




End Sub