Hi
After reading, searching, breaking my head... I still couldn't find a solution for what seems a quite easy thing in the first place.
I want to check if a cell has a certain colour. If so, it needs to cehck if the date linked to this cell is part of an array of bank holidays.
If that's also true, a counter must count + 1.
Unfortunately, I feel like missing a serious basic view on the problem, because it simply won't work.
Is there anyone who can get me on the correct way please?
The code I ended up after multiple if x = a comparisons is the following (checking if dateserial(1 JAN 2020) = dateserial(1 JAN 2020)).
This gives no error, but the counter stays at 0. So at this moment it doens't make sense to cehck the whole array BankHolidays for the date 1 JAN 2020 to be part of it.
Function CountColorIfBankHoliday(rSample As Range, rArea As Range) As Long
Dim rAreaCell As Range
Dim tableRange As Range
Dim lMatchColor As Long
Dim lCounter As Long
Dim BankHolidays(8) As Date
BankHolidays(0) = DateSerial(2021, 1, 1) 'NY
BankHolidays(1) = DateSerial(2021, 4, 5) 'Easter Monday
BankHolidays(2) = DateSerial(2021, 5, 1) 'Labour Day
BankHolidays(3) = DateSerial(2021, 5, 24) 'Whit Monday
BankHolidays(4) = DateSerial(2021, 7, 21) 'National Day
BankHolidays(5) = DateSerial(2021, 8, 15) 'Assumption Day
BankHolidays(6) = DateSerial(2021, 11, 1) 'All Saints' Day
BankHolidays(7) = DateSerial(2021, 11, 11) 'Armistice Day
BankHolidays(8) = DateSerial(2021, 12, 25) 'Christmas Day
Dim i As Integer
Dim month As Integer
Dim day As Integer
Dim match
lMatchColor = rSample.Interior.Color
For Each rAreaCell In rArea
If rAreaCell.Interior.Color = lMatchColor Then
On Error Resume Next
match = Application.match(BankHolidays(0), DateSerial(2021, 1, 1), 0)
If Not IsError(match) Then
lCounter = lCounter + 1
End If
On Error GoTo 0
End If
Next
'Debug.Print "Counter: " & lCounter
CountColorIfBankHoliday = lCounter
End Function
Many many many thanks for the one who can help me out here.
Bookmarks