Introduction

Time management has been a topic of conversation since the dawn of man. For example, in the Book of Proverbs, Solomon refers to sluggards or lazy people, who are really people who suffer from poor time management.

Let’s call this time mismanagement type 1.

Still on Biblical examples, the Book of Job gives us our time mismanagement type 2. In this book, there is mention of those who work iniquity; this can be seen as a form of time mismanagement because a type 2 will work in harming society.

I hope most of you reading are not usually of type 2, but if you’re of type 1, and let’s face it, most of us are, then I’ve got the VBA script for you!

An Overview of the Spreadsheet Task Collector

We all have different ways of managing our time: some use physical planners, some use apps on their phones, and others use Microsoft Excel 2019.

I find that physical planners are often inconvenient, and phones don’t quite fit into my workflow. Furthermore, I think that physical planners are better for important dates, whereas Excel is better for less critical, more frequent and data-driven tasks.

(When I say data-driven, I’m referring to tasks that have some metadata to them that allows for easy categorization.)

Since I’m a full-time student, most of my tasks right now relate to college, so I have a very logical organization to the workbook that I use to keep track of tasks. Specifically, I use a spreadsheet to track the tasks for each course.

However, I don’t think this is ideal for larger courseloads like what I’m working with because it’s tedious to click through each spreadsheet and parse through each row, looking for something that’s due soon and making a mental note of it.

This process is annoying and inefficient, so in this article, I’m going to go through the code of the macro I used to solve this problem.

Please note that the complete source code can be found on my GitHub page or at the end of this article. Also, the code is licensed under the MIT license. (I was initially going to use the GPL but remembered I’m making a macro in Excel, which is already a proprietary program.)

VBA Code

Objective: An interactive button placed on an Excel spreadsheet meant to hold upcoming tasks (the time for what is upcoming is user-defined) is linked to a macro that parses through all the entries in the workbook for upcoming tasks and puts those into the upcoming tasks spreadsheet, along with appropriate color coding.

Note: I have removed comments as they seem to confuse the code highlighter tool I’m using.

Public Sub RefreshUpcoming()

Call PrepareUpcoming
Call LookForDue

Worksheets("Upcoming").Activate

Call SortByDueDate

End Sub

Sub PrepareUpcoming()

With Worksheets("Upcoming")
    Cells.ClearContents
    Cells.ClearFormats
    
    Range("A1") = "Type"
    Range("B1") = "Task"
    Range("C1") = "Due"
    Range("D1") = "Completed"
    Range("E1") = "Time (min)"
    Range("F1") = "Est (min)"
    
    Range("A1", "F1").Font.Bold = True
End With

End Sub

Sub LookForDue()

Dim nameColor As New Dictionary
nameColor.Add "Sheet1", 37
nameColor.Add "Sheet2", 13
nameColor.Add "Sheet3", 6
nameColor.Add "Sheet4", 42

Dim today As Date
today = Date

For i = 2 To Worksheets.Count
    Worksheets(i).Activate
    
    For j = 3 To Worksheets(i).Rows.Count
        If DateDiff("d", Range("C" & CStr(j)).Value, today) <= 7 And DateDiff("m", Range("C" & CStr(j)).Value, today) _
        = 0 And IsEmpty(Range("D" & CStr(j))) = True Then
            Call AddTaskToUpcoming(CStr(j), nameColor)
        End If
        
        If IsEmpty(Range("A" & CStr(j))) = True Then
            Exit For
        End If
    Next j
Next i

End Sub

Sub AddTaskToUpcoming(rowNumber As String, nameColor As Dictionary)

Dim rowColor As String
rowColor = nameColor.Item(ActiveSheet.Name)

Dim firstEmptyRow As Integer
firstEmptyRow = FindFirstEmptyRow()

Worksheets("Upcoming").Range("A" & firstEmptyRow, "F" & firstEmptyRow).Value = _
ActiveSheet.Range("A" & rowNumber, "F" & rowNumber).Value

Worksheets("Upcoming").Range("A" & firstEmptyRow, "F" & firstEmptyRow).Interior.ColorIndex = rowColor

End Sub

Function FindFirstEmptyRow() As String

For i = 1 To Worksheets("Upcoming").Rows.Count
    If IsEmpty(Worksheets("Upcoming").Range("A" & CStr(i))) = True Then
        FindFirstEmptyRow = i
        Exit For
    End If
Next i

End Function

Sub SortByDueDate()

Dim firstEmptyRow As String
firstEmptyRow = CStr(CInt(FindFirstEmptyRow - 1))

Worksheets("Upcoming").Sort.SortFields.Clear

Range("A1", "F" & firstEmptyRow).Sort Key1:=Range("C1"), Header:=xlYes

End Sub