Option Explicit

Enum rawdata_columns
    rw_day = 1
    rw_weekday
    rw_time
    rw_task
    rw_completed_by
    rw_approved_by
    rw_exceptions
    rw_day_increment '+1 means time is given for day after valuation day, for example
    rw_comment
End Enum 'rawdata columns

Enum today_columns
    td_time = 1
    td_task
    td_completed_by
    td_approved_by
    td_exceptions
End Enum 'today columns

Sub Build_Tasklist()
'Source (EN): http://www.sulprobil.de/sbtasklist_en/
'Source (DE): http://www.berndplumhoff.de/sbtasklist_de/
'(C) (P) by Bernd Plumhoff 12-Sep-2022 PB V1.07

Dim bTBD               As Boolean 'To be done?

Dim dt                 As Date

Dim lrw                As Long
Dim ltd                As Long

Dim s                  As String

Dim v                  As Variant

'See http://www.sulprobil.de/systemstate_en/ to understand next two rows
Dim state              As SystemState

Set state = New SystemState

Application.Calculate
wsToday.Activate
wsToday.Rows("4:1048576").Delete

'Set destination column widths to source's
wsToday.Columns(Chr(64 + td_time) & ":" & Chr(64 + td_time)).ColumnWidth = _
    wsRawData.Columns(Chr(64 + rw_time) & ":" & Chr(64 + rw_time)).ColumnWidth
wsToday.Columns(Chr(64 + td_task) & ":" & Chr(64 + td_task)).ColumnWidth = _
    wsRawData.Columns(Chr(64 + rw_task) & ":" & Chr(64 + rw_task)).ColumnWidth
wsToday.Columns(Chr(64 + td_completed_by) & ":" & Chr(64 + td_completed_by)).ColumnWidth = _
    wsRawData.Columns(Chr(64 + rw_completed_by) & ":" & Chr(64 + rw_completed_by)).ColumnWidth
wsToday.Columns(Chr(64 + td_approved_by) & ":" & Chr(64 + td_approved_by)).ColumnWidth = _
    wsRawData.Columns(Chr(64 + rw_approved_by) & ":" & Chr(64 + rw_approved_by)).ColumnWidth
wsToday.Columns(Chr(64 + td_exceptions) & ":" & Chr(64 + td_exceptions)).ColumnWidth = _
    wsRawData.Columns(Chr(64 + rw_exceptions) & ":" & Chr(64 + rw_exceptions)).ColumnWidth
    
lrw = 4: ltd = 4
Do While Not (IsEmpty(wsRawData.Cells(lrw, rw_time))) 'As long as we have tasks timed ...

    Application.StatusBar = "Processing RawData row " & lrw & " ..."
    'Determine whether source row needs to be copied
    bTBD = False
    If IsEmpty(wsRawData.Cells(lrw, rw_day)) And IsEmpty(wsRawData.Cells(lrw, rw_weekday)) Then
        bTBD = True 'Empty rows will be copied
    Else
        'Check Month Day
        If Not (IsEmpty(wsRawData.Cells(lrw, rw_day))) Then
            For Each v In Split(wsRawData.Cells(lrw, rw_day).Text, ",")
                If CLng(v) = wsParam.Range("Evaldate_WDMS") Or CLng(v) = wsParam.Range("Evaldate_WDME") Then
                    bTBD = True 'Right day from month start or month end: copy!
                    Exit For
                End If
            Next v
        End If
        'Check Weekday
        If Not (IsEmpty(wsRawData.Cells(lrw, rw_weekday))) Then
            For Each v In Split(wsRawData.Cells(lrw, rw_weekday).Text, ",")
                If CLng(v) = wsParam.Range("Evaldate_Weekday") Then
                    bTBD = True 'Right weekday: copy!
                    Exit For
                End If
            Next v
        End If
    End If
            
    If bTBD Then
        'Task needs to be done - copy into sheet Today
        wsRawData.Range(wsRawData.Cells(lrw, rw_time), wsRawData.Cells(lrw, rw_exceptions)).Copy
        wsToday.Range(Cells(ltd, td_time), Cells(ltd, td_exceptions)).PasteSpecial Paste:=xlPasteValues
        wsToday.Range(Cells(ltd, td_time), Cells(ltd, td_exceptions)).PasteSpecial Paste:=xlPasteFormats
        wsToday.Range(Cells(ltd, td_time), Cells(ltd, td_exceptions)).PasteSpecial Paste:=xlPasteAllUsingSourceTheme
        
        dt = Range("Evaldate") + wsRawData.Cells(lrw, rw_day_increment) + wsRawData.Cells(lrw, rw_time)
        dt = ConvertTime(dt, "Central European Standard Time", "Pacific Standard Time")
        s = Format(dt, "hh:nn") & " PST" & IIf(dt - Range("Evaldate") > 1, _
            " +" & Format(Int(dt - Range("Evaldate")), "0"), "") & vbCrLf
        dt = Range("Evaldate") + wsRawData.Cells(lrw, rw_day_increment) + wsRawData.Cells(lrw, rw_time)
        s = s & Format(dt, "hh:nn") & " CET" & IIf(dt - Range("Evaldate") > 1, _
            " +" & Format(Int(dt - Range("Evaldate")), "0"), "") & vbCrLf
        dt = ConvertTime(dt, "Central European Standard Time", "India Standard Time")
        s = s & Format(dt, "hh:nn") & " IST" & IIf(dt - Range("Evaldate") > 1, _
            " +" & Format(Int(dt - Range("Evaldate")), "0"), "") & vbCrLf
        wsToday.Cells(ltd, td_time) = s
        
        wsToday.Rows(ltd & ":" & ltd).EntireRow.AutoFit
        If wsToday.Rows(ltd & ":" & ltd).RowHeight < wsRawData.Rows(lrw & ":" & lrw).RowHeight Then
            wsToday.Rows(ltd & ":" & ltd).RowHeight = wsRawData.Rows(lrw & ":" & lrw).RowHeight
        End If
        ltd = ltd + 1
    End If
    lrw = lrw + 1
Loop

With wsToday.PageSetup
    .PrintTitleRows = "$1:$3"
    .PrintArea = "$A$1:$" & Chr(64 + td_exceptions) & "$" & ltd - 1
    On Error Resume Next 'Quick and dirty because next command rows will fail in case no printer is defined
    .Orientation = xlPortrait
    .FitToPagesWide = 1
    .FitToPagesTall = 1 + Int(ltd / 5) 'Just to ensure that we have enough pages
    .LeftFooter = wsParam.Range("Footer_Text")
    .CenterFooter = ""
    .RightFooter = "Page &P/&N"
    On Error GoTo 0
End With

End Sub