Budget // Use VB to pull individual expenses for a category into the total for the category

[SuperCoolKev]

Hey all, thanks for looking at my question.

What I'm trying to do is create a VB program for my budget.

In my budget, I have two areas for data. One area shows a running total of my current allowance & expenses for any category, and the other area is where I enter each individual expense.

I have about 25 categories in my budget. When I update it, I enter all of my expenses into the individual expense area. Then I have to manually add them to the total's area.

If I can create a VB program that will test the budget category in the individual expense area against the budget category's in the total's area, and when it finds a match, have it pull the individual expense's value in the neighboring cell and add it to the total value next to the category name in the totals area, it would save me a ton of time.

I'm not sure where to begin. I think I could do this with a huge if statement, but I would have to program a 25 line deep if statement, and that may bog down my spreadsheet. I'd rather take on the challenge of making something in VB that I can run. Thanks in advance for the help.

 

[The_Macrotect]

Hey SuperCoolKev,

What you'd like done can almost certainly be done. It would be helpful if you could post a sample of your worksheet or be extremely specific with data ranges and sheet names.

All the best,
Matt

 

[SuperCoolKev]

Hey Matt,

Thanks for coming by man. I pasted the links to the image's here. In case they don't imbed, here they are:

Totals area: https://imgur.com/99RIgsC

Individual expenses: https://imgur.com/M2iBeIJ

The idea is to pull the individual inputs in the individual expenses area into the totals area to keep running totals for each category throughout the month.

 

[The_Macrotect]

Kev,

I think I understand - To be clear, you'd like to:

Add the spending amount to the budget area in the totals section after you enter the figures into the individual expense section, right?

Are the individual and total areas on the same sheet, or different sheets?

Should the individual figures get added to the projected figures in the totals section?


Matt

 

[SuperCoolKev]

Yes! you've got the right idea.

I'll manually enter spending amounts as individual expenses. Once that's done, I want to pull those into the totals section.

They are on the same sheet. Each workbook has 12 sheets, one for each month.

The individual figures wouldn't be added to the projected figures; only to the yellow "actual" column.

Kev

 

[The_Macrotect]

Great! Ok, final question and I should be able to get to work:

Where on the sheet is your individual section, and where are your totals (what rows and columns)?

Matt

 

[SuperCoolKev]

Individuals are in column N starting on row 3. Totals are Column F, rows 8 to 31. Here's a pic for reference: https://imgur.com/d3AXDFQ

 

[The_Macrotect]

Ok, here's what I came up with. After you input your individual transaction, select any cell in that transaction's row and run the macro.

Please note: Running the macro will populate column H with an "X". This is to ensure that each transaction only posts once to the totals area. If you're using column for something else, let me know and we can change it's location.

**Back up your work and try on a copy first**

Here's the code:

Sub Update_Total()
Dim amount As Long, area_ind As String, area_tot As String, x As Integer

amount = Cells(ActiveCell.Row, 14).Value
area_ind = Cells(ActiveCell.Row, 15).Value
x = 8

If amount = 0 Then
MsgBox ("Enter an amount and retry the macro")
GoTo abort
Else
End If

If area_ind = "" Then
MsgBox ("Activate any cell in the row that you'd like to add to the ""Totals"" area and retry the macro.")
GoTo abort
Else
End If

If Cells(ActiveCell.Row, 8) = "X" Then
MsgBox ("This transaction has already been posted")
GoTo complete
Else
End If

Cells(ActiveCell.Row, 8) = "X"

Do Until area_tot = area_ind
If x = 100 Then
MsgBox ("Budget Area Not Found - Check Spelling and Try Again")
GoTo abort
Else
End If

area_tot = Cells(x, 2).Value
x = x + 1

Loop


Cells(x - 1, 6) = Cells(x - 1, 6) + amount
GoTo complete

abort:
Cells(ActiveCell.Row, 8).ClearContents

complete:
End Sub