How to get the total of every monday to saturday or tuesday to sunday in a month dynamically

Question

I'm attempting to find out how to multiply the number of working hours by the number of days in a month, such as every Monday through Saturday or Tuesday through Sunday. What the user chooses to enter the cell relies on them. The CALCULATION, however, is based on the date that the user inputs in a textbox or cell.

If UCase(val) Like "*TO*" Then

Dim numStringTo As Integer
Dim strToDays() As String
Dim wordToCount As Long

numStringTo = 3

strToDays = VBA.Split(val, " ")
wordToCount = UBound(strToDays)
whEveryDay = ThisWorkbook.Sheets("Input").Cells(X, 4).Value
whEveryDay = whEveryDay * Weekday(nb_days, 6)
Debug.Print "Every = " & whEveryDay

End If

I need to get the total of days in a month and multiply by working hours. As of now we are in January 2023 and the pattern for January is 2-7,9-14,16-21,23-28,30-31 and the patter for November 2022 is 1-5,8-12,15-19,22-26,29-30.

For example:

Days	Date	Working Hours
every Monday to Saturday	2-7,9-14,16-21,23-28,30-31	1.2
every Tuesday to Saturday	1-5,8-12,15-19,22-26,29-30	0.5

Example of calculation:

Days * Working hours

And I need the computation to be dynamic, so for instance, the number of days in a month will change if I change the cell from "every Monday to Saturday" to "every Wednesday to Monday."

Answer 1

Try this:

Option Explicit
Sub demo()
    Dim lastrow As Long, r As Long, s As String, dt As Date
    s = InputBox("Input Date")
    If IsDate(s) Then
        dt = CDate(s)
    Else
        MsgBox s & " not a date", vbCritical
        Exit Sub
    End If

    With ThisWorkbook.Sheets("Input")
        lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
        For r = 2 To lastrow
            s = .Cells(r, "B").Value
            If UCase(s) Like "*TO*" Then
               ' total days in column E
               .Cells(r, "E") = mydatecalc(dt, s)
               ' hrs per day * days
               .Cells(r, "F").FormulaR1C1 = "=RC[-2]*RC[-1]"
            End If
        Next
    End With
    MsgBox "Calc done for " & Format(dt, "mmm yyyy")
End Sub

Function mydatecalc(dtNow As Date, s As String) As Long

    Dim m As Integer, s1 As String, s2 As String, d As String
    Dim dt As Date, dtStart As Date, dtEnd As Date
    Dim n As Integer, ar, bCount As Boolean, msg As String
         
    m = Month(dtNow) ' input month
    dtStart = DateSerial(Year(dtNow), m, 1)
    dtEnd = DateAdd("m", 1, dtStart) - 1
    
    ar = Split(s, " ")
    s1 = Left(ar(1), 3)
    s2 = Left(ar(3), 3)
    
    For dt = dtStart To dtEnd
        d = Format(dt, "ddd")
        If d = s1 Then bCount = True
        If bCount Then
            n = n + 1
            msg = msg & vbLf & n & " " & Format(dt, "ddd dd")
        End If
        If d = s2 Then bCount = False
    Next
    
    'MsgBox s & " = " & n & " days in " & Format(dtNow, "mmm yyyy") & msg
    mydatecalc = n
End Function