Hi,
I'm new to creating macro's in excel but not new to writing code. I've just been given a task by my boss to create some macro's in an excel spreadsheet we use as a booking database.
He has asked me to create a macro that will filter the bookings relative to the date it is today. The date filters required are:
-> Show only last weeks bookings
-> Show only the upcoming weeks bookings
I'm using excel 2007 and have found the built in "xlfilter" functions. The only problem is that Ecxel see's a week starting on Sunday. Being that we are an entertainment agency most of our bookings are "Thursday to Sunday" so I need excel to see a week as starting on Monday and finishing on the following Sunday.
In my research I just haven't been able to find a way to define the week. I can get the filter to work on everything else the way I want but not dates.
I'm sure I'm missing something totally obvious.
I've included the code to the macro I have for your convenience.
Sub Weekly_Report_Copy()
Dim Rng1 As Range
Set Rng1 = RealUsedRange
If Rng1 Is Nothing Then
MsgBox "There is no used range, the worksheet is empty."
Else
Windows("BOOKING PROGRAM.xlsm").Activate
Sheets("MAIN").Select
ActiveSheet.Range("$A:$AU").AutoFilter Field:=9, Criteria1:=xlFilterLastWeek, Operator:=xlFilterDynamic
ActiveSheet.Range("$A:$AU").AutoFilter Field:=10, Criteria1:="=BOOKED", Operator:=xlOr, Criteria2:="=PRIVATE"
Columns("E:G").Select
Selection.EntireColumn.Hidden = True
Columns("R:AE").Select
Selection.EntireColumn.Hidden = True
Columns("AI:AU").Select
Selection.EntireColumn.Hidden = True
RealUsedRange.Select
RealUsedRange.Activate
Selection.Copy
Workbooks.Open Filename:="<path on network>\Weekly.xlsx"
Range("A1").Select
ActiveSheet.Paste
Cells.Select
Selection.Columns.AutoFit
Windows("BOOKING PROGRAM.xlsm").Activate
Columns("E:G").Select
Selection.EntireColumn.Hidden = False
Columns("R:AE").Select
Selection.EntireColumn.Hidden = False
Columns("AI:AU").Select
Selection.EntireColumn.Hidden = False
Windows("Weekly.xlsx").Activate
End If
End Sub
Bookmarks