Amount of holidays within a range of dates

[silentwolf]

Hi guys,

I am stuck with following.

I got a function wich returns a boolean when a date ist a public holiday.. i found this code on the net.. works fine ...
However now I like to create a new function which returns the amount of hoidays within a range of dates.

Function HolidaysWithinRange(datStart As Date, datEnd As Date) As Integer
    Dim lngDays As Long
    Application.Volatile
    
    Dim lngCount As Long
    
    For lngDays = 1 To CLng(datEnd - datStart)
        
        If lngDays = 1 Then
            Feiertag (datStart)
        
        Else
            Feiertag (datStart) + lngDays           
        End If 
    
    If Feiertag(datDate) = True Then
        HolidaysWithinRange =         HolidaysWithinRange + 1   
    End If
    
    Next lngDays


End Function

The function "Feiertag" requires only one parameter a date and retourns true or false if the date is a holiday

But I like to get the amount of holidays out from the function above but somehow not really have luck to figure it out.

Can someone put me in the right direction please?

Many thanks

SW

 

[mart37]

If lngDays = 1 Then
If Feiertag (datStart) = True Then HolidaysWithinRange = HolidaysWithinRange + 1
Else
If Feiertag (datStart) + lngDays = True Then HolidaysWithinRange = HolidaysWithinRange + 1
End If

 

[silentwolf]

If lngDays = 1 Then
If Feiertag (datStart) = True Then HolidaysWithinRange = HolidaysWithinRange + 1
Else
If Feiertag (datStart) + lngDays = True Then HolidaysWithinRange = HolidaysWithinRange + 1
End If

Hi Thanks for your reply,

will check it and get back to you!

Cheers

 

[Phuoc]

Try this

Function HolidaysWithinRange(datStart As Date, datEnd As Date) As Long
    Dim lngDays As Long
    Application.Volatile
   
    For lngDays = datStart To datEnd
        If Feiertag(lngDays) = True Then
            HolidaysWithinRange = HolidaysWithinRange + 1
        End If
    Next lngDays
   
End Function

 

[silentwolf]

Hi again,

I changed the code as following..

But that does not seam to change the date within the function "Feiertag"

Function HolidaysWithinRange(datStart As Date, datEnd As Date) As Integer
    Dim lngDays As Long
    Application.Volatile
    
    Dim lngCount As Long
    
    For lngDays = 1 To CLng(datEnd - datStart)
        
        If lngDays = 1 Then
            If Feiertag(datStart) = True Then HolidaysWithinRange = HolidaysWithinRange + 1
        Else
            If Feiertag(datStart + lngDays) = True Then HolidaysWithinRange = HolidaysWithinRange + 1
        End If
    
    Next lngDays
End Function

 

[silentwolf]

Try this

Function HolidaysWithinRange(datStart As Date, datEnd As Date) As Integer
    Dim lngDays As Long
    Application.Volatile
   
    For lngDays = datStart To datEnd
        If Feiertag(lngDays) = True Then
            HolidaysWithinRange = HolidaysWithinRange + 1
        End If
    Next lngDays
   
End Function

Hi,
thanks to you too..
no unfortunatelly it is always stuck on the first date when it jumps to the "Feiertag" function...

I guess you ment

Function HolidaysWithinRange(datStart As Date, datEnd As Date) As Integer
    Dim lngDays As Long
    Application.Volatile
    
    Dim datDate As Date
    
    For lngDays = datStart To datEnd
        If Feiertag([B]datStart[/B]) = True Then
            HolidaysWithinRange = HolidaysWithinRange + 1
        End If
    Next lngDays
    
End Function

Thanks for your help!

 

[Phuoc]

Can you share the full code of the Feiertag function?

 

[silentwolf]

Sure,

Function Feiertag(Datum) As Boolean 'GMG-CC.de
    Dim Jahr As Integer, Ostern As Date, Hl3Koenige As Date
    Dim Dreikönig As Date
    Dim Neujahr As Date, Karfreitag As Date, OsterMontag As Date
    Dim TagDerArbeit As Date, Pfingsten As Date, PfingstMontag As Date
    Dim Himmelfahrt As Date, TagDerEinheit As Date, HeiligAbend As Date
    Dim Weihnacht1 As Date, Weihnacht2 As Date, Silvester As Date
    Dim Altweiber As Date, Rosenmontag As Date, Fronleichnam As Date
    Dim MariaHimmelfahrt As Date, Reformationstag As Date, Allerheiligen As Date
    'Bei Bedarf weitere Feiertage hier deklarieren
    
    Jahr = Year(Datum)
    'Bundes-einheitlich
    Ostern = OsterSonntag(Jahr)
    Neujahr = DateSerial(Jahr, 1, 1)
    Karfreitag = Ostern - 2
    OsterMontag = Ostern + 1
    TagDerArbeit = DateSerial(Jahr, 5, 1)
    Himmelfahrt = Ostern + 39
    Pfingsten = Ostern + 49
    PfingstMontag = Ostern + 50
    TagDerEinheit = DateSerial(Jahr, 10, 3)
    Weihnacht1 = DateSerial(Jahr, 12, 25)
    Weihnacht2 = DateSerial(Jahr, 12, 26)
    'Definitions-Frage
    HeiligAbend = DateSerial(Jahr, 12, 24)
    Silvester = DateSerial(Jahr, 12, 31)
    'Regional bedingt
    Hl3Koenige = DateSerial(Jahr, 1, 6)
    Altweiber = Ostern - 52
    Rosenmontag = Ostern - 48
    Fronleichnam = Ostern + 60
    MariaHimmelfahrt = DateSerial(Jahr, 8, 15)
    Reformationstag = DateSerial(Jahr, 10, 31)
    Allerheiligen = DateSerial(Jahr, 11, 1)
    'Bei Bedarf weitere Feiertage hier initialisieren
    
    Select Case Datum
    Case Ostern, Neujahr, Karfreitag, OsterMontag, TagDerArbeit, _
    Himmelfahrt, Pfingsten, PfingstMontag, TagDerEinheit, _
    Weihnacht1, Weihnacht2
    Feiertag = True
    ' Falls auch Feiertage, Kommentar-Marker in nächsen 2 Zeilen entfernen
    '   Case HeiligAbend, Silvester
    '      Feiertag = True
    ' Bei Bedarf noch weitere Feiertage nach diesem Muster hinzufügen
    End Select
    
End Function

Thanks for your help!

 

[silentwolf]

Hi again,

does anyone can help me further with this code?
Would be much appreciated if someone can put me in the right direction...

Many Thanks
SW

 

[mart37]

Function HolidaysWithinRange(datStart As Date, datEnd As Date) As Integer
    Dim lngDays As Date
    Application.Volatile
    For lngDays = datStart To datEnd
        If Feiertag(lngDays) = True Then
            HolidaysWithinRange = HolidaysWithinRange + 1
        End If
    Next lngDays
End Function

Function Feiertag(Datum As Date) As Boolean 'GMG-CC.de
...