copy expense account details into category columns with totals

[mikedee1400]

Hi.

I have an expense account spreadsheet with about 50 categories from cell D1 to cell BB1.

Whenever I make any payments, i insert the Month in column A; the Category e.g. electricity, transport etc starting in column B, and the corresponding Amount paid in column C (with a total of the Amounts paid at the bottom of column C).

is there any code that I could use to automatically copy the Amount from column C into a cell in the same row under Category in (D1 : BB1) that matches the Category in Column B.

I realise that I could use a pivot table for this, but the pivot table automatically totals the amounts per category, which I do not want.

Many thanks

Mike<SCRIPT language=JavaScript src="http://www.interq.or.jp/sun/puremis...[/XD][XH][/XH][/XR][/RANGE][/XH][/XR][/RANGE]

 

[Jon von der Heyden]

Welcome to MrExcel.com

Place this formula in D2 and then copy all the way thru to end of range (in your example I9:

=(D$1=$B2)*$C2

 

[mikedee1400]

Hi Jon. I'm actually looking for VBA code to do the work.

With 50 columns and thousands of rows, it would make for a very large file using formulas in each cell.

Thanks

 

[Jon von der Heyden]

Try this.

ASSUMPTIONS:

1. Columns ABC house Month, Category and Amount.
2. Your last column is one prior to the Total column.
3. Your last row is one prior to the Total row.
4. Column labels in row 1.

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> PutData()<br><br><SPAN style="color:#00007F">With</SPAN> Application<br>    .ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    .EnableEvents = <SPAN style="color:#00007F">False</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><br><SPAN style="color:#00007F">Dim</SPAN> rRng <SPAN style="color:#00007F">As</SPAN> Range, rCell <SPAN style="color:#00007F">As</SPAN> Range<br><br><SPAN style="color:#00007F">Set</SPAN> rRng = Range("D2").Resize(Cells(Rows.Count, 1).End(xlUp).Row - 2, Cells(2, Columns.Count).End(xlToLeft).Column - 4)<br><br><SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> rCell <SPAN style="color:#00007F">In</SPAN> rRng<br>    <SPAN style="color:#00007F">If</SPAN> Cells(rCell.Row, 2) = Cells(1, rCell.Column) <SPAN style="color:#00007F">Then</SPAN><br>        rCell = Cells(rCell.Row, 3)<br>    <SPAN style="color:#00007F">Else</SPAN><br>        rCell = ""<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br><SPAN style="color:#00007F">Next</SPAN> rCell<br><br>Application.EnableEvents = <SPAN style="color:#00007F">True</SPAN><br><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

 

[mikedee1400]

Hi Jon.

Almost there !

Is there any way that the code could run by specifying a start point till the end of the range - in this case cells D2 to cell I8 ?

Reason : a few rows below the table, I have some notes and a smaller data table for personal expenses (similar to the above).

When I run the macro, it deletes all the cells in the range D11:I20 (between the 2 tables) - and then continues to work on my personal expense table.

To understand what I mean, try copying cells A1:J10 to A20, and then insert some text or numbers anywhere in the range D11:I20

I could then probably create another macro to work on my personal expenses

Many thanks and sorry for the bother.

 

[Jon von der Heyden]

Try this. Given your sample select D2:I8 when prompted to select a range.

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> PutData()<br><br><SPAN style="color:#00007F">Dim</SPAN> rRng <SPAN style="color:#00007F">As</SPAN> Range, rCell <SPAN style="color:#00007F">As</SPAN> Range<br><br><SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">Resume</SPAN> <SPAN style="color:#00007F">Next</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> rRng = Application.InputBox(prompt:="Select range", Type:=8)<br><SPAN style="color:#00007F">On</SPAN> <SPAN style="color:#00007F">Error</SPAN> <SPAN style="color:#00007F">GoTo</SPAN> 0<br><br><SPAN style="color:#00007F">If</SPAN> rRng <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br><br><SPAN style="color:#00007F">With</SPAN> Application<br>    .ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    .EnableEvents = <SPAN style="color:#00007F">False</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><br><SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> rCell <SPAN style="color:#00007F">In</SPAN> rRng<br>    <SPAN style="color:#00007F">If</SPAN> Cells(rCell.Row, 2) = Cells(1, rCell.Column) <SPAN style="color:#00007F">Then</SPAN><br>        rCell = Cells(rCell.Row, 3)<br>    <SPAN style="color:#00007F">Else</SPAN><br>        rCell = ""<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br><SPAN style="color:#00007F">Next</SPAN> rCell<br><br>Application.EnableEvents = <SPAN style="color:#00007F">True</SPAN><br><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

 

[mikedee1400]

Couldn't have asked for more !!!

Many thanks for your time and effort.

Best regards

Mike