Remove Holidays as DateSerial using Case

D

David

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
 
T

Tom Ogilvy

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
 
D

David

Bombed on the res = Application line.
Do I need to have the Range of Holidays defined somewhere?
Thanks for the help!
 
D

David

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!!
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top