Overview
I’ve been hesitant to switch to Excel because there is not yet a transaction splitter. I decided to build one using VBA. I would consider this good enough until Tiller puts one together and adds it to the menu so no coding is required.
The code will split your transaction and give you the opportunity to edit the “Amount”,“Category” and “Description” fields.
Installation
I would recommend installing this only if you have some familiarity with VBA. The code works, but it’s VBA, so you should be able to know how to install and how to run. The code is here:
VBA Code
Sub SplitTransactionWithCustomAmounts()
Dim ws As Worksheet
Dim selectedRow As Range
Dim headerRow As Range
Dim descCol As Long
Dim amtCol As Long
Dim catCol As Long
Dim noteCol As Long
Dim dateCol As Long
Dim numRowsToAdd As Long
Dim i As Long
Dim splitAmts() As Variant
Dim splitcat() As String
Dim splitDesc() As String
Dim totalSplitAmt As Double
' Set references to the active worksheet, selected row, and header row
Set ws = ActiveSheet
Set selectedRow = ws.Cells.Find(What:="*", SearchDirection:=xlPrevious)
Set headerRow = selectedRow.End(xlUp)
' Put in the correct column number for the fields below:
dateCol = 1 ' Column A for Date
descCol = 2 ' Column B for Description
catCol = 3 ' Column C for Category
amtCol = 4 ' Column D for Amount
noteCol = 20 ' Column T for Note
' Get the original transaction information from the selected row
Dim origDesc As String
Dim origAmt As Double
Dim origDate As String
origDesc = Cells(activeCell.Row, descCol)
origAmt = Cells(activeCell.Row, amtCol)
origDate = Cells(activeCell.Row, dateCol)
origrow = activeCell.Row
' Prompt user to confirm split and verify $0 split
Dim confirmMsg As String
If origAmt = 0 Then
confirmMsg = "Amount of transaction on selected row is $0. Do you still want to continue?"
If MsgBox(confirmMsg, vbYesNo, "Continue?") <> vbYes Then
Exit Sub
End If
End If
confirmMsg = "Please confirm the following transaction details:" & vbCrLf _
& "Date: " & origDate & vbCrLf _
& "Description: " & origDesc & vbCrLf _
& "Amount: " & origAmt & vbCrLf & vbCrLf _
& "Do you want to split this transaction?"
If MsgBox(confirmMsg, vbYesNo, "Confirm Split") <> vbYes Then
Exit Sub
End If
Dim fullinput As String
Dim splitinput As Variant
numRowsToAdd = Application.InputBox("Enter the number of splits needed: (include the original row in the split) ", "Number of Splits")
If numRowsToAdd < 2 Then Exit Sub ' Exit the sub if the user inputs 0 or a negative number
ReDim splitAmts(1 To numRowsToAdd)
ReDim splitcat(1 To numRowsToAdd)
ReDim splitDesc(1 To numRowsToAdd)
For i = 1 To numRowsToAdd
fullinput = Application.InputBox("Enter the amount, category and description for split " _
& vbNewLine & i & " of " & numRowsToAdd & " (each separated by a comma):" & vbNewLine & _
vbNewLine & "You may leave a field blank but you must still put in a comma." _
& vbNewLine & "Total split so far: $" & totalSplitAmt & ". Original Amount: $" & origAmt & " Amount Left to Split: $" & origAmt - totalSplitAmt)
splitinput = Split(fullinput, ",")
splitAmts(i) = splitinput(0)
splitcat(i) = splitinput(1)
splitDesc(i) = splitinput(2)
If Not IsNumeric(splitAmts(i)) Or splitAmts(i) = 0 Then
MsgBox "Invalid input for split amount. Please enter a valid number.", vbExclamation
Exit Sub
End If
totalSplitAmt = totalSplitAmt + splitAmts(i)
Next i
If Round(totalSplitAmt, 4) <> Round(origAmt, 4) Then
MsgBox "The total amount of the splits does not equal the original amount. Please adjust the split amounts.", vbExclamation
Exit Sub
End If
' Last chance to exit.
confirmMsg = "Please confirm the following splits:" & vbNewLine & vbNewLine
For i = 1 To numRowsToAdd
confirmMsg = confirmMsg & " Split " & i & ": Amount:" & Format(splitAmts(i), "$#,##0.00") & _
" Category: " & splitcat(i) & " Desc: " & splitDesc(i) & vbNewLine
Next i
confirmMsg = confirmMsg & vbNewLine & "Total: " & Format(totalSplitAmt, "$#,##0.00") & vbNewLine & vbNewLine & "Is this correct?"
' Ask user to confirm the splits
Dim confirmResult As VbMsgBoxResult
' confirmResult = MsgBox(confirmMsg, vbYesNo + vbQuestion, "Confirm Splits")
confirmResult = MsgBox(confirmMsg, vbYesNo + vbQuestion + vbDefaultButton2, "Confirm Splits")
If confirmResult = vbYes Then
' The following two commands speeds up the code by turning off Excel's auto calculation and screenupdating.
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' Insert new rows for splits
For i = 2 To numRowsToAdd
' Insert a new row
Rows(activeCell.Row + i - 1).Insert Shift:=xlDown
' Copy data from original row
Rows(activeCell.Row).Copy Rows(activeCell.Row + i - 1)
' Update amount for split
Cells(activeCell.Row + i - 1, amtCol).Value = splitAmts(i)
' Update category for split
Cells(activeCell.Row + i - 1, catCol).Value = splitcat(i)
' Update description for split
Cells(activeCell.Row + i - 1, descCol).Value = splitDesc(i)
' Update note for split
Cells(activeCell.Row + i - 1, noteCol).Value = FormatCurrency(splitAmts(i)) & " of " & FormatCurrency(origAmt) & " split from " & origDesc & " on " & origDate
Next i
' Update amount for original row
Cells(activeCell.Row, amtCol).Value = splitAmts(1)
' Update category for original row
Cells(activeCell.Row, catCol).Value = splitcat(1)
' Update description for split
Cells(activeCell.Row, descCol).Value = splitDesc(1)
' Update note for original row
Cells(activeCell.Row, noteCol).Value = FormatCurrency(Cells(activeCell.Row, amtCol).Value) & " of " & FormatCurrency(origAmt) & " split from " & origDesc & " on " & origDate
' Reset the selection to the first cell in the original row
Cells(activeCell.Row, amtCol).Select
' Turn on screen updating and resume calculations.
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
' Show success message to user
MsgBox "The transaction has been split successfully.", vbInformation, "Split Transaction"
Else
' Show message to user that the split was cancelled
MsgBox "The split transaction was cancelled.", vbExclamation, "Split Transaction"
Exit Sub
End If
End Sub
Setup
I tried to minimize the calculations, so some things are hard coded. You must enter the correct row number for the “Date,Amount,Category, Description and Note.” That is the only thing that must be entered.
The code also turns off automatic calculations and screen updates to speed it up.
Feel free to remove that, but it will slow it down a lot, and if you happen to click on a cell while it’s running, it might mess it up.
Usage
To run, just make sure you are in a row you want to split and run the macro. I put in a button in my own Tiller sheet to make it easier. I did give a couple of opportunities to “ctrl-break” and exit. Once you confirm the dialog box where the splits are presented, the code will execute.
Permissions
Is it ok for others to copy, use, and modify your workflow?
Yes
I ran this many times on my own data and it runs fine. I did a maximum of 12 splits and it returned within a few seconds and worked fine. However, like all codes, please verify first before you run since once it writes data you can’t undo.