Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 01-04-2021, 08:02 PM
Stephen Ray Stephen Ray is offline Need a Function with Select Case for the Holidays Windows 10 Need a Function with Select Case for the Holidays Office 2016
Advanced Beginner
Need a Function with Select Case for the Holidays
 
Join Date: Sep 2018
Location: Kansas
Posts: 34
Stephen Ray is on a distinguished road
Default Need a Function with Select Case for the Holidays

Hello!
I have written a really simple Macro that works very well but I would like to make it more compact and elegant. I would like to know how to make a function with a Select Case for the Holidays. I just cannot figure that out. After I know how to do that, I want to make it more and more compact.

This Macro Calculates a Date, it takes the current date and adds 14 working days, excluding weekends and Holidays. The current date is not counted.
Then it puts that calculated date into the clipboard and shows a box for about 1 second.

Thanks in advance,

Sub Macro5()
'The Idea is to Find Weekdays, then find Holidays that are Weekdays
' Macro5 Macro
'
Dim TodaysDate As Date
Dim DateBirthday As Date
TodaysDate = Date
Dim count As Integer
count = 14

Dim TestDay As Date
TestDay = Date

Dim vDate As Date
vDate = Date

Dim DayOfWeekNumber As Integer


HolidayA = CDate("01/01/21")
HolidayB = CDate("01/02/21")
HolidayC = CDate("01/30/21")



'The 1st Day Never Counts, so advance one day.
If TodaysDate = Date Then
vDate = DateAdd("d", 1, vDate) 'Add 1 day to vdate
End If

Do While count > 0

DayOfWeekNumber = Weekday(vDate)

'1 for Sunday 2 for Monday 3 for Tuesday... 6 for Friday 7 forSaturday

'If TodaysDate is not a Weekend, Then it must be a Weekday.
If Not ((DayOfWeekNumber = 1) Or (DayOfWeekNumber = 7)) Then
'Weekday

count = count - 1
If ((vDate = HolidayA) Or (vDate = HolidayB) Or (vDate = HolidayC)) Then
vDate = DateAdd("d", 1, vDate) 'Add 1 day to vdate

End If

Else
'Weekend

End If

If count > 0 Then
vDate = DateAdd("d", 1, vDate) 'Add 1 day to vdate
End If
Loop








Dim strBothItems As String
Dim firstPart As String
Dim datePart As String


firstPart = "Fourteen Days from Today "
datePart = vDate
strBothItems = firstPart & datePart

Selection.TypeText vDate
Selection.MoveLeft Unit:=wdCharacter, count:=10
Selection.Find.ClearFormatting
With Selection.Find

.Text = "-"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Application.StatusBar = strBothItems
Selection.MoveLeft Unit:=wdCharacter, count:=3
Selection.MoveRight Unit:=wdCharacter, count:=10, Extend:=wdExtend
Selection.Copy
Application.StatusBar = strBothItems
ActiveDocument.ActiveWindow.Caption = strBothItems & " " & ActiveDocument
'MsgBox strBothItems & " On Your ClipBoard"
'Application.StatusBar = strBothItems
Dim AckTime As Integer, InfoBox As Object
Set InfoBox = CreateObject("WScript.Shell")
'Set the message box to close after 3 seconds
AckTime = 1
Select Case InfoBox.Popup(strBothItems & " On Your ClipBoard", _
AckTime, "On Your ClipBoard", 0)
Case 1, -1
'Exit Sub
End Select
Application.StatusBar = strBothItems


End Sub
Reply With Quote
  #2  
Old 01-04-2021, 11:13 PM
gmayor's Avatar
gmayor gmayor is offline Need a Function with Select Case for the Holidays Windows 10 Need a Function with Select Case for the Holidays Office 2016
Expert
 
Join Date: Aug 2014
Posts: 4,101
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

Well it could certainly be simplified
Code:
Option Explicit

Sub Macro6()
'The Idea is to Find Weekdays, then find Holidays that are Weekdays
'Graham Mayor - https://www.gmayor.com - Last updated - 05 Jan 2021
Dim Count As Integer
Dim TestDay As Date
Dim sMessage As String
Dim vHolidays As Variant
Dim i As Integer, j As Integer
Dim oRng As Range
Dim dDate As DataObject

vHolidays = Array("01/01/21", "01/02/21", "01/30/21")    'add the holidays to the array

    Count = 14
    TestDay = Date    'CDate("01/01/21")

    For i = 1 To 14
        If Weekday(TestDay + i) = 1 Or Weekday(TestDay + i) = 7 Then
            Count = Count + 1
            'if added day is at the weekend add another day
            If Weekday(TestDay + Count) = 1 Or Weekday(TestDay + Count) = 7 Then Count = Count + 1
        End If
    Next i

    For j = 0 To UBound(vHolidays)
        If TestDay = CDate(vHolidays(j)) Then
            Count = Count + 1
            'probably unnecessary but if added day is at the weekend add another day
            If Weekday(TestDay + Count) = 1 Or Weekday(TestDay + Count) = 7 Then Count = Count + 1
        End If
    Next j

    TestDay = DateAdd("d", Count, TestDay)     'Add count to TestDay

    Selection.TypeText TestDay    'optional as the date is written to the clipboard

    Set dDate = New DataObject
    dDate.SetText TestDay
    dDate.PutInClipboard

    sMessage = "14 Working Days from Today - " & TestDay
    MsgBox sMessage, vbInformation, "Add working days"
    Set dDate = Nothing
End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote
  #3  
Old 01-04-2021, 11:36 PM
macropod's Avatar
macropod macropod is offline Need a Function with Select Case for the Holidays Windows 10 Need a Function with Select Case for the Holidays Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

For a non-macro solution, see Handling Weekends and Holidays in Calculated Dates in my Microsoft Word Date Calculation Tutorial: https://www.msofficeforums.com/word/...-tutorial.html
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #4  
Old 01-05-2021, 08:03 AM
gmaxey gmaxey is offline Need a Function with Select Case for the Holidays Windows 10 Need a Function with Select Case for the Holidays Office 2016
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,422
gmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the rough
Default

Graham has shown you a way using and array. Paul, using fields. You don't really need a select case for the holidays. You could also use an error handler and leverage the fact that keys in collections can't be duplicated:

Code:
Sub Test()
  MsgBox Format(fcnAdvancedDate("1/6/2021"), "MMMM dd, yyyy")
  MsgBox fcnAdvancedDate
End Sub


Function fcnAdvancedDate(Optional StartDate As Variant, Optional DaysToCount As Long = 14) As Date
Dim lngIndex As Long
Dim dateTmp As Date
Dim varHolidays As Variant
Dim colHolidays As New Collection
 varHolidays = Array("01/01/21", "01/18/21", "02/15/21")
 dateTmp = Date
 If IsDate(StartDate) Then dateTmp = StartDate
 For lngIndex = 0 To UBound(varHolidays)
   colHolidays.Add varHolidays(lngIndex), varHolidays(lngIndex)
 Next lngIndex
 lngIndex = 0
 Do
   dateTmp = DateAdd("d", 1, dateTmp)
   Select Case Weekday(dateTmp)
     Case 2 To 6
       On Error Resume Next
       colHolidays.Add Format(dateTmp, "MM/dd/yy"), Format(dateTmp, "MM/dd/yy")
       If Err.Number = 0 Then
         lngIndex = lngIndex + 1
         colHolidays.Remove (colHolidays.Count)
       End If
   End Select
 Loop Until lngIndex = DaysToCount
 fcnAdvancedDate = dateTmp
lbl_Exit:
  Exit Function
End Function
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/

Last edited by gmaxey; 01-05-2021 at 04:45 PM.
Reply With Quote
  #5  
Old 01-05-2021, 04:43 PM
Stephen Ray Stephen Ray is offline Need a Function with Select Case for the Holidays Windows 10 Need a Function with Select Case for the Holidays Office 2016
Advanced Beginner
Need a Function with Select Case for the Holidays
 
Join Date: Sep 2018
Location: Kansas
Posts: 34
Stephen Ray is on a distinguished road
Default

gmayor, macropod, gmaxey, Thank you very much, I appreciate your efforts. It will take some time to read, study and digest your ideas. So I will be studying Arrays now too. I will get back to you, but it will take some time.

I really need some good books to study.

Last edited by Stephen Ray; 01-05-2021 at 04:44 PM. Reason: too much white space
Reply With Quote
  #6  
Old 01-06-2021, 03:32 PM
Stephen Ray Stephen Ray is offline Need a Function with Select Case for the Holidays Windows 10 Need a Function with Select Case for the Holidays Office 2016
Advanced Beginner
Need a Function with Select Case for the Holidays
 
Join Date: Sep 2018
Location: Kansas
Posts: 34
Stephen Ray is on a distinguished road
Default

GMayor, I copied the code you supplied and got an error that I don't know how to fix.

This is what my code looks like:
End Sub




Option Explicit

Sub Macro7()
'The Idea is to Find Weekdays, then find Holidays that are Weekdays
'Graham Mayor - Graham Mayor - Home Page - Last updated - 05 Jan 2021
Dim Count As Integer
Dim TestDay As Date
Dim sMessage As String
Dim vHolidays As Variant
Dim i As Integer, j As Integer
Dim oRng As Range
Dim dDate As DataObject

dDate As DataObject is highlighted in Blue and it says:
Compile Error
User-Defined Type not defined.

Where did I go wrong?
Reply With Quote
  #7  
Old 01-06-2021, 04:04 PM
gmaxey gmaxey is offline Need a Function with Select Case for the Holidays Windows 10 Need a Function with Select Case for the Holidays Office 2016
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,422
gmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the rough
Default

You need a reference to the MicrosoftForms 2.0 object library.


You said you needed a function. Why don't you use the function I gave you?
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote
  #8  
Old 01-06-2021, 04:40 PM
Stephen Ray Stephen Ray is offline Need a Function with Select Case for the Holidays Windows 10 Need a Function with Select Case for the Holidays Office 2016
Advanced Beginner
Need a Function with Select Case for the Holidays
 
Join Date: Sep 2018
Location: Kansas
Posts: 34
Stephen Ray is on a distinguished road
Default

GMaxey, I got the code you supplied to work. I understand some of your code. Very interesting, an Array. And two boxes appear. I have enough to go on now. The Select Case you used tests for weekdays.
Concerning this line:


fcnAdvancedDate(Optional StartDate As Variant, Optional DaysToCount As Long = 14) As Date


Where do I go to learn about the parts to the right and left of the comma ?


And the parentheses ?


Thanks,
Reply With Quote
  #9  
Old 01-06-2021, 05:05 PM
Stephen Ray Stephen Ray is offline Need a Function with Select Case for the Holidays Windows 10 Need a Function with Select Case for the Holidays Office 2016
Advanced Beginner
Need a Function with Select Case for the Holidays
 
Join Date: Sep 2018
Location: Kansas
Posts: 34
Stephen Ray is on a distinguished road
Default

GMaxey, I didn't see your previous post. I was busy studying your code! I appreciate your help. And right now, I don't want you to write any more code for me because I want to do it. But I do need your help understanding the format/syntax of


fcnAdvancedDate(Optional StartDate As Variant, Optional DaysToCount As Long = 14) As Date


Later, I think I will be able to add another Select Case to your code for the Holidays found on the Weekends. And later I will figure out how to choose Friday or Monday for the day off work in those cases when the holiday falls on a weekend.


If the holiday falls on Saturday, the day off work is always Friday.
If the holiday falls on Sunday, the day off work is always Monday.


But I've got to do it one step at a time, get one thing working well, then do the next step.


Thanks again,
Reply With Quote
  #10  
Old 01-07-2021, 02:16 PM
gmaxey gmaxey is offline Need a Function with Select Case for the Holidays Windows 10 Need a Function with Select Case for the Holidays Office 2016
Expert
 
Join Date: May 2010
Location: Brasstown, NC
Posts: 1,422
gmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the roughgmaxey is a jewel in the rough
Default

They are called parameters and in that code, they are optional. See if this helps:

Code:
Sub SubSimple()
  'You can run this sub directly.
  MsgBox "Hello Stephen"
End Sub
Sub WithParameters(strGreeting As String, strName As String)
  'This sub has required parameters it can only be called by another sub passing arguments.
  MsgBox strGreeting & " " & strName
End Sub
Sub WithOptionalParameters(Optional strGreeting As String = "Hello", Optional strName As String = "Stephen")
  'This sub has optional parameters it can only be called by another sub with or with passing arguments.
  MsgBox strGreeting & " " & strName
End Sub
Function fcnOffsetDate(Optional StartDate, Optional lngOffset As Long = 7) As Date
'Functions return a value to the the calling procedure.
'This functions have optional parameters. The optional parameters define the defaults.
Dim dateTmp As Date
  dateTmp = Date
  If IsDate(StartDate) Then dateTmp = StartDate
  fcnOffsetDate = DateAdd("d", lngOffset, dateTmp)
End Function

Sub CallingSub()
  'Call each of the examples. Step through this procedure using the F8 key.
  SubSimple
  WithParameters "Hello", "Steven Ray" 'the arguments must be passed.
  WithOptionalParameters 'The parameters are optional so no arguments have to be passed.
  MsgBox fcnOffsetDate 'The parameters are optional so no arguments have to be passed.
  MsgBox fcnOffsetDate("12/31/2021", 25) 'We are passing optional arguments.
End Sub
__________________
Greg Maxey
Please visit my web site at http://www.gregmaxey.com/
Reply With Quote
  #11  
Old 01-07-2021, 02:26 PM
Stephen Ray Stephen Ray is offline Need a Function with Select Case for the Holidays Windows 10 Need a Function with Select Case for the Holidays Office 2016
Advanced Beginner
Need a Function with Select Case for the Holidays
 
Join Date: Sep 2018
Location: Kansas
Posts: 34
Stephen Ray is on a distinguished road
Default

GMaxey, Thank you very much. I just finished work, I am exhausted. So I cannot look at your code right now. I have several irons in the fire. But be sure, I will study your code, write a new Macro, and show you later. These are the times that try mens' souls.
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Need a Function with Select Case for the Holidays Can Select Case be used to defined the Value of an item in a drop down list? mbews Word VBA 10 10-08-2020 05:04 AM
Need a Function with Select Case for the Holidays Toggle between upper case, lower case, etc... by one single macro on a Mac, to emulate Shift + F3 on gloub Word VBA 2 01-30-2019 12:40 PM
Need a Function with Select Case for the Holidays SENDKEYS with vbYesNoCancel and Select Case kiwimtnbkr Word VBA 31 06-11-2018 04:56 AM
Need a Function with Select Case for the Holidays Use function to select another worksheet eugeneradial Excel 2 04-27-2017 04:53 AM
Help with Case and Select case brent chadwick Word VBA 34 10-18-2015 02:13 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 03:04 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft