Transaction Splitter for Excel (VBA)


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.


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"
    ' Show message to user that the split was cancelled
    MsgBox "The split transaction was cancelled.", vbExclamation, "Split Transaction"
Exit Sub
End If
End Sub


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.


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.


Is it ok for others to copy, use, and modify your workflow?

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.

One thing to note is that this runs on the active sheet. I didn’t put in a restriction to only run on Transactions, so it’s theoretically possible to split on another sheet if the amount is in the same column.

Wow, @yossiea. Just found a moment to give this a try today.

It’s so cool.

I’m a fan of keyboard workflows and while the text entry isn’t very sexy, it’s incredibly functional and easy. As the Tiller team starts to think on new approaches to transaction splitting for both Sheets and Excel, I’m curious to hear how others respond to this.

This is a great stopgap— or long-term solution!— to those of you interested in a splits workflow for Excel.

Thanks. I had fun writing and rewriting this, as well as relearning my vba. I’m sure I can figure out a way to add drop-down using forms, but that would require more than just vba and I haven’t really used forms within vba.

That works great! One thing though that I added after this is a check to make sure you’re on the Transactions sheet. Other than that, I think this is a great addition.

-edit - Never mind, it doesn’t work anymore. I have no idea why.