Remove Holidays as DateSerial using Case
GOT IT!
I set up some dates and gave the range the name HOLIDAYS and it worked
perfect!
Thank you so much for your time!!
"Tom Ogilvy" wrote:
Dim res as Variant
.. . .
For iCtr = DateSerial(Year(myDate), Month(myDate), 1) To
DateSerial(Year(myDate), _
Month(myDate) + 1, 0)
res = Application.Match(clng(ictr),Range("Holidays"),0)
if iserror(res) then
Select Case Weekday(iCtr)
Case Is = CaseSat '(Does all days, remove '& does only weekdays)
'do nothing
Case Is = CaseSun '(Does all days, remove ' & does only weekdays)
'do nothing
Case Else
Application.StatusBar = D
SH.Copy after:=Sheets(Sheets.Count)
N = Sheets.Count - 3
'ActiveSheet.Range("A1").Value = D
ActiveSheet.Name = Format(iCtr, "dddd mm-dd")
Range("H4") = Format(iCtr, "mm/dd/yy")
Range("H8") = N
End Select
end if
Next
--
Regards,
Tom Ogilvy
"David" wrote in message
...
I've finally got some code put together that does exactly what I want.
However, I forgot that I need to remove holidays!! This code asks the user
which month to set up, and whether they want to include Saturdays and
Sundays
before the worksheets for the month are set up. I'm using the CASE
structure
to do this.
What I need is a CASE statement that will NOT include holidays. I can have
the serial numbers or dates for the holidays listed somewhere, but I can't
figure out the code to make it work.
Would someone mind taking a look? Thanks Much!!
Here's the full code:
Sub CreateMonth()
Dim SH As Worksheet
Dim wCtr As Long
Dim myDate As Variant
Dim D As Date, Y As Long
Dim N As String
Dim DDate As String
Dim CaseSat As String
Dim CaseSun As String
Worksheets("DMR Master").Activate
Set SH = ActiveSheet
myDate = InputBox(Prompt:="Enter the FIRST DAY of the Month you want to
Create", _
Default:=Format(Date, "mm/dd/yy"))
Msg = "Do You Want to Include Saturdays as a Workday?"
Ans = MsgBox(Msg, vbYesNo)
If Ans = vbNo Then
CaseSat = vbSaturday
Else
CaseSat = ""
End If
Msg = "Do You Want to Include Sundays as a Workday?"
Ans = MsgBox(Msg, vbYesNo)
If Ans = vbNo Then
CaseSun = vbSunday
Else
CaseSun = ""
End If
Application.ScreenUpdating = False
myDate = CDate(myDate)
For iCtr = DateSerial(Year(myDate), Month(myDate), 1) To
DateSerial(Year(myDate), _
Month(myDate) + 1, 0)
Select Case Weekday(iCtr)
Case Is = CaseSat '(Does all days, remove '& does only weekdays)
'do nothing
Case Is = CaseSun '(Does all days, remove ' & does only weekdays)
'do nothing
Case Else
Application.StatusBar = D
SH.Copy after:=Sheets(Sheets.Count)
N = Sheets.Count - 3
'ActiveSheet.Range("A1").Value = D
ActiveSheet.Name = Format(iCtr, "dddd mm-dd")
Range("H4") = Format(iCtr, "mm/dd/yy")
Range("H8") = N
End Select
Next
Sheets(4).Activate
Range("D8") = N
For wCtr = 4 To Worksheets.Count
'If Worksheets(wCtr).Name = Worksheets("Setup").Name Then
'skip it
'Else
Worksheets(wCtr).Activate
Range("D8") = N
'End If
Next wCtr
Worksheets("Setup").Activate
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub
|