DataNumen Debt Manager – A Free Debt Management System in Your Excel

If you are paying a lot of loans and bills, this article is very important for you, as you will learn how to track all your bill payments in your Excel easily. You can set reminders, upcoming payments without difficulty.

Download Now

If you want to start to use the software as soon as possible, then you can:

Download the Software Now

Otherwise, if you want to DIY, you can read the contents below.

Let’s Prepare the GUI

As shown in the image, prepare the Entry and Database sheet with necessary fields, headers, and buttons.Sheet Entry

Sheet Database

Let’s make it functional

Copy the script to a new module and attach macro to buttons as shown in this table

Name Attach to button
Add_debt Add
Delete_Debt Remove

How does it work?

The macro “Add_Debt” identifies the last used row in the sheet “Database”. It then identifies the monthly due date of the debt and adds it to the sheet “Database”. The macro “Debt_dropDown” identifies unique names of debts and adds it as drop down on the sheet Entry. Before running the macro “Delete_Debt”, the user has to select a debt name from the drop down. This macro then identifies all matching rows from the sheet “Database” and deletes them.

Sub Add_Debt()
    Dim v_name As String
    Dim v_amount As Variant
    Dim v_end As Date
    Dim v_start As Date
    Dim lr As Long
    v_start = CDate(entry.Range("B8").Value & "/" & Format(Now, "mm/yyyy"))
    Debug.Print v_start
    v_end = CDate(entry.Range("B8").Value & "/" & Format(entry.Range("B14").Value, "mm/yyyy"))
    Do While v_start < v_end
        lr = db.Range("A" & Rows.Count).End(xlUp).Row + 1
        db.Range("A" & lr).Value = entry.Range("B5").Value
        db.Range("B" & lr).Value = DateAdd("m", 1, v_start)
        db.Range("C" & lr).Value = entry.Range("B11").Value
        db.Range("D" & lr).Value = "Unpaid"
        Debug.Print DateAdd("m", 1, v_start)
        v_start = DateAdd("m", 1, v_start)
    Loop
    Debug.Print v_end
End Sub

Sub Debt_dropDown()
    Application.DisplayAlerts = False
    On Error Resume Next
    Sheets("Temp").Delete
    Sheets.Add.Name = "Temp"
    On Error GoTo 0
    Sheets("Database").Select
    Columns("A:A").Select
    Selection.Copy
    Sheets("Temp").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Range("$A$1:$A$1000").RemoveDuplicates Columns:=1, Header:=xlYes
    Range("A2").Select
    Dim lr As Long
    Dim r As Long
    lr = Sheets("Temp").Range("A" & Rows.Count).End(xlUp).Row
    Dim prodlist As String
    For r = 2 To lr
        If prodlist = "" Then
            prodlist = Sheets("Temp").Range("A" & r).Value
        Else
            prodlist = prodlist & "," & Sheets("Temp").Range("A" & r).Value
        End If
        Next r
        With entry.Range("G5:J5").Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:=prodlist
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
        With entry.Range("L5:P5").Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:=prodlist
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
        On Error Resume Next
        Sheets("Temp").Delete
        Sheets.Add.Name = "Temp"
        On Error GoTo 0
End Sub
    
Sub Delete_Debt()
    Dim lr As Long
    lr = db.Range("A" & Rows.Count).End(xlUp).Row
    For r = 2 To lr
        If db.Range("A" & r).Value = entry.Range("G5").Value Then
            db.Range("A" & r).EntireRow.ClearContents
        End If
        Next r
        db.Columns("A:D").Select
        ActiveWorkbook.Worksheets("Database").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("Database").Sort.SortFields.Add Key:=Range("A2:A1000" _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("Database").Sort
            .SetRange Range("A1:D1000")
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
End Sub

Tweak the macro

You can tweak the macro to update the status of each debt, show upcoming debts or show closed debts. If this macro enabled workbook is corrupted, to recover Excel xlsm file you can try copying the code to a new workbook. Then recreate sheets and save the new workbook as macro enabled workbook.

Author Introduction:

Nick Vipond is a data recovery expert in DataNumen, Inc., which is the world leader in data recovery technologies, including corrupted word and outlook recovery software products. For more information visit www.datanumen.com.

Leave a Reply

Your email address will not be published. Required fields are marked *