How do I Extract multiple lines by Date to another worksheet 1

[2ks]

Can anyone point me in a new direction.

I have a macro that looks at tomorrows date and extracts lines of data using tomorrows date, where that value os found in a particular column. Now this, although clunky macro does its job but I need a version in which the date can vary by user input (either calendar or input box.

Original very Clunky macro

Sub Tomorrows_Appointments()
'
' Tomorrows_Appointments Macro
' Macro recorded 14/01/2007 by Home
'

'

ActiveSheet.Unprotect

Selection.AutoFilter Field:=27, Criteria1:=Date + 1


Sheets("DAS").Select
Range("A2:E350").Select
Selection.ClearContents
Sheets("AMF").Select
Range("A17:A317").Select
Selection.copy
Sheets("DAS").Select
Range("A2").Select
ActiveSheet.Paste
Sheets("AMF").Select
ActiveWindow.SmallScroll ToRight:=-1
Range("b17:b317").Select
Application.CutCopyMode = False
Selection.copy
Sheets("DAS").Select
Range("B2").Select
ActiveSheet.Paste
Sheets("AMF").Select
Range("aa17:aa317").Select
Application.CutCopyMode = False
Selection.copy
Sheets("DAS").Select
Range("C2").Select
ActiveSheet.Paste

Sheets("AMF").Select
Range("ab17:ab317").Select
Application.CutCopyMode = False
Selection.copy
Sheets("DAS").Select
Range("d2").Select
ActiveSheet.Paste
Sheets("AMF").Select
Range("d17:d317").Select
Range("d317").Activate
Application.CutCopyMode = False
Selection.copy
Sheets("DAS").Select
Range("e2").Select
ActiveSheet.Paste
Sheets("AMF").Select
Range("e17:e317").Select
Application.CutCopyMode = False
Selection.copy
Sheets("DAS").Select
Range("f2").Select
ActiveSheet.Paste
Range("E5").Select
Application.CutCopyMode = False


MsgBox "Your DAS will now be saved"

Sheets("DAS").Select
Sheets("DAS").copy

If Weekday(Now(), 2) > 4 Then

inc = 8 - Weekday(Now(), 2)

Else

inc = 1

End If

ActiveWorkbook.SaveAs ("H:\My Documents\NEWWORK\DAS " & Format((Now() + inc), "dd""-""mmm""-""yyyy") & ".xls")

'
ActiveWindow.Close
Application.WindowState = xlMaximized

MsgBox "The DAS has been saved as requested"

Sheets("AMF").Select
Range("B3:C3").Select

Sheets("AMF").Select
Range("B3:C3").Select

ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFiltering:=True, AllowUsingPivotTables:=True

End Sub

 

[PHV]

A starting point:
Selection.AutoFilter Field:=27, Criteria1:=CVDate(InputBox("Date", "Enter a date", 1 + Date))

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[SkipVought]

Hi,

I cleaned up your code and added a few comments...

Sub Tomorrows_Appointments()
'
' Tomorrows_Appointments Macro
' Macro recorded 14/01/2007 by Home
'

'

'make ActiveSheet and Explicit Sheet Object Reference
    ActiveSheet.Unprotect
'make SELECTION an Explicit Range Object Reference INCLUDING Sheet Object.

'substitute for Date the Range Reference of the user-selected date

    Selection.AutoFilter Field:=27, Criteria1:=Date + 1
    
    
    Sheets("DAS").Range("A2:E350").ClearContents
    
    Sheets("AMF").Range("A17:A317").Copy Sheets("DAS").Range("A2")
    
    Sheets("AMF").Range("b17:b317").Copy Sheets("DAS").Range("B2")
    
    Sheets("AMF").Range("aa17:aa317").Copy Sheets("DAS").Range("C2")
    
    Sheets("AMF").Range("ab17:ab317").Copy Sheets("DAS").Range("d2")
    
    Sheets("AMF").Range("d17:d317").Copy Sheets("DAS").Range("e2")
    
    Sheets("AMF").Range("e17:e317").Copy Sheets("DAS").Range("f2")
            
    MsgBox "Your DAS will now be saved"
    
    Sheets("DAS").Copy
    
    If Weekday(Now(), 2) > 4 Then

        inc = 8 - Weekday(Now(), 2)

    Else
    
        inc = 1
    
    End If

    ActiveWorkbook.SaveAs ("H:\My Documents\NEWWORK\DAS " & Format((Now() + inc), "dd""-""mmm""-""yyyy") & ".xls")

'
    ActiveWindow.Close
    Application.WindowState = xlMaximized
    
    MsgBox "The DAS has been saved as requested"
    
    Sheets("AMF").Protect _
        DrawingObjects:=False, _
        Contents:=True, _
        Scenarios:=False, _
        AllowFiltering:=True, _
        AllowUsingPivotTables:=True
 
End Sub

Skip,

_[red][/red]

 

[2ks]

Thanks both for this. On the right track.

PHV - That code almost works but the date it slects from is brought onto the sheet from a userform and c.offset process after matching unique ref no.

When I run your suggestion it misses the date I request.

If I overtype the date in column 27 manually it catches it when run. What could this be?

Many thanks

 

[SkipVought]

The "date" from your TEXTbox is probably just that -- TEXT.

You must CONVERT your text string to a REAL DATE, which is a NUMBER, like today is 39157.

dim dDate as date, sDateString as string
sDateString =  "3/16/2007"
sDate = DateValue(sDateString)

DateValue does the same thing as the date delimiter...

dDate = #3/16/2007#

Since there is ambiguity between the American & British formats for date, it is best to either use the DateSerial function, parsing any date string into year, month & day parts or using a yyyy/mm/dd date string format.

Skip,

_[red][/red]

 

[2ks]

Guys

Just to update you. Got all that working fine now. I have to drop the CVDate from the date selector and all perfect.

Thanks both

2ks