“Patience has its limits. Take it too far, and it is cowardice.” [George Jackson]

Abstract

If your team runs many different manual tasks, not all of them on each working day but only on specified weekdays or days of a month, then this tasklist creator might be of help to you.

In sheet Param enter your team name or other reference which will be put into the footer of each page, and enter ther valuation day:

sbTasklist_Param

Define in sheet RawData which tasks needs to be done on which days and set the time of the day this needs to be started. It is not necessary to order all tasks by the time but it might help:

sbTasklist_RawData

Now press the button in sheet Param. You will get in sheet Today:

sbTasklist_Today

Print sheet Today. Let your team sign off the tasks (when they are done!) and let them note any exceptions (problems, errors, etc.) encountered. I used to scan the signed tasklist at the end of each day to stay paperless and to provide an audit trail.

Note: You can run the whole process paperless if you enter all data electronically and store the final file as pdf.

Appendix – sbTaskList Code

Please note that this program requires (uses) the function ConvertTime which you can find at (external link!) https://stackoverflow.com/questions/3120915/get-timezone-information-in-vba-excel/20489651#20489651 (No worries, it is contained in the file provided below).

Please read my Disclaimer.

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

Download

Please read my Disclaimer.

sbtasklist.xlsm [66 KB Excel file, open and use at your own risk]