Can a Message box be brought up in the middle of code asking for criteria?

Hello all,

I have a worksheet with several columns (30+). One of these columns is "Date Opened". This "date opened" column can have dates as early as 01/01/89 and as recent as today.

Can a macro be made that does this

1. Data/Sorts the whole worksheet by the "Date opened" column
2. Brings up a message box in xx/xx/xxxx where format saying "Please enter the earliest date opened you would like to use, all other rows will be deleted"
3. Do just that, delete all rows that have a date earlier than the date entered in the message box.

So if the date of 01/01/2009 were entered into the message box, the macro would delete all dates in the "Date Opened" column that were older than that date.

And then, continue on with the rest of the sub, if neccessary.


thanks,

duugg

Sub Test()
     Dim D As Date, DateCol As Range, Dx As Range
     
     Set DateCol = Range("A:A")

     For Each Dx in DateCol
          If Dx="" Then Exit For
          If Dx < D Then Dx.EntireRow.Delete
     Next Dx
End Sub

My mistake, you didn't specify a column for the "Date Opened" so I just used column A with some random date values entered. So:

duuggzdates.xls

This one works but you will have to specify the rows and columns in the macro.

Option Explicit
Sub test()
    'this macro is built expecting dates in column A, i.e., col #1 and row #2
    
    Dim TestDate    As Date, _
        DateRange   As Range, _
        DateCol     As String, _
        LastRow     As Long, _
        ctrl        As Long, _
        FirstRow    As Long

    TestDate = InputBox("enter the earliest date to use: mm/dd/yyyy")
    
    DateCol = "A"       '<============== change to suit
    FirstRow = 2        '<============== change to suit
    LastRow = Cells(Rows.Count, DateCol).End(xlUp).Row
    
    Set DateRange = Range(DateCol & FirstRow & ":" & DateCol & LastRow)

    Range(DateCol & FirstRow).Select
    Selection.Sort _
        Key1:=Range(DateCol & FirstRow), _
        Order1:=xlAscending, _
        Header:=xlGuess, _
        OrderCustom:=1, _
        MatchCase:=False, _
        Orientation:=xlTopToBottom
        
    Application.ScreenUpdating = False
    
    'start at the bottom of the list and work upward
    For ctrl = LastRow To FirstRow Step -1
        Select Case Range(DateCol & ctrl).Value
            Case Is < TestDate
                Range(DateCol & ctrl).EntireRow.Delete
            Case Is > TestDate
                Range(DateCol & ctrl).EntireRow.Delete
        End Select
    Next ctrl
    
    Application.ScreenUpdating = True
End Sub

duuggzdates.xls