A macro to consolidate many budgets into summary sheet

[Kim B]

Hello all. I have tried to take code from other board posts and make it work with what I am trying to do and am failing miserably. This macro is not that difficult, at least I don't think so compared to what I have seen done. I have 100 budgets that need to be consolidated into a seperate summary sheet. Column D5 on the first html, will determine what dept the budget comes from. So column b on the second html will change when the range has been exhausted on each budget. The range is B9:B132 from the first html. The directory in which the budgets are stored is g:\accounting\private\msdacct\planning\2011\budgets\budgets reviewed.

Thanks in advance

Excel Workbook
	B	C	D	E	F	G	H
1
2
3
4
5		DEPARTMENT:	69311	INFORMATION SYSTEMS
6		MANAGER:
7
8	ACCOUNT	DESCRIPTION	Q1	Q2	Q3	Q4	2010
9	502104 - UA	OTH NON-OH EXP - TAXES					0
10	511101 - UA	SALARY & WAGE - INDIRECT LABOR	96,980	99,241	99,241	99,241	394,703
11	513004 - UA	EMPLOYEE - TRAINING	3,500	3,500	3,500	3,500	14,000
12	520001 - UA	TRAVEL EXPENSE - TRANSPORT AIR	3,000	3,000	3,000	3,000	12,000
13	520002 - UA	TRAVEL EXPENSE - TRNSPORT LAND	1,200	1,200	1,200	1,200	4,800
14	520003 - UA	TRAVEL EXPENSE - ACCOMMODATION	3,000	3,000	3,000	3,000	12,000
15	520004 - UA	TRAVEL EXPENSE - MEALS	1,080	1,080	1,080	1,080	4,320
16	520005 - UA	TRAVEL EXPENSE - ENTERTAINMENT					0
17	520007 - UA	TRAVEL EXPENSE - GENERAL	200	200	200	200	800
18	531003 - UA	RENTS - OFFICE EQUIPMENTS					0
19	531012 - UA	REPAIR & MAINTENANCE - MACH	1,750	1,750	1,750	1,750	7,000
20	531013 - UA	REPAIR & MAINTENANCE					0
21	531091 - UA	COMMODITY - PPV					0
22	531201 - UA	TELEPHONE	10,045	10,045	10,045	10,045	40,180
23	531203 - UA	IT NETWORK	12,875	10,450	10,450	10,450	44,224
24	531204 - UA	SOFTWARE	8,914	8,382	8,382	9,382	35,061
25	531411 - UA	NON-OPERATING SUPPLIES	425	425	425	425	1,700
26	532103 - UA	OUTSOURCED SERVICE - ACCOUNTIN					0
27	532104 - UA	OUTSOURCED SERVICES - OTHER					0
28	532105 - UA	OUTSOURCED SERVICE - CONSULTIN	25,000	23,000	25,000	20,000	93,000
29	552101 - UA	FREIGHT - INBOUND	75	75	75	75	300
30	552201 - UA	FREIGHT - OUTBOUND	150	150	150	150	600
31	591501 - UA	DEPRECIATION - EQUIPMENT	34,328	31,793	31,793	29,355	127,269
109							0
110							0
111							0
112							0
113							0
114							0
115							0
116							0
117							0
118							0
119							0
120							0
121							0
122	512001	DIRECT - SOCIAL SECURITY	0	0	0	0	0
123	512002	DIRECT - UNEMPLOYMENT INSURANC	0	0	0	0	0
124	512005	DIRECT - MEDICAL	0	0	0	0	0
125	512006	DIRECT - LIFE INSURANCE	0	0	0	0	0
126	512101	INDIRECT - SOCIAL SECURITY	7,419	7,592	7,592	7,592	30,195
127	512102	INDIRECT - UNEMPLOYMENT INSUR	1,545	1,545	1,545	1,545	6,180
128	512105	INDIRECT - MEDICAL	13,017	13,017	13,017	13,017	52,069
129	512106	INDIRECT - LIFE INSURANCE	894	894	894	894	3,575
130	512201	DIRECT - 401K	0	0	0	0	0
131	512301	INDIRECT - 401K	6,837	6,996	6,996	6,996	27,824
132		TOTAL	232,232	227,335	229,335	222,896	911,799
Budget

And consolidate into this

Excel Workbook
	A	B	C	D	E	F	G	H	I
2	UA	11111	503201	LABOR ABSORPTION	(128,262)	(120,008)	(109,641)	(111,789)	(469,700.00)
3	UA	11111	511001	SALARY & WAGE - DIRECT LABOR	96,674	90,453	66,112	67,406	320,645.50
4	UA	11111	511003	VACATION - DIRECT LABOR	2,913	10,196	14,727	12,462	40,298.16
5	UA	11111	511007	SAL&WAGE PREMIUM-DIRECT LABOR	4,394	4,112	3,005	3,064	14,574.80
6	UA	11111	511101	SALARY & WAGE - INDIRECT LABOR	15,521	15,987	15,987	15,987	63,481.02
7	UA	11111	511107	SAL&WAGE PREMIUM-INDIRECT LAB	1,000	1,000	1,000	1,000	4,000.00
8	UA	11111	531012	REPAIR & MAINTENANCE - MACH	250	250	250	250	1,000.00
9	UA	11111	531306	NON-CAPITALIZED TOOLS	800	800	800	800	3,200.00
10	UA	11111	531399	CHEMICAL - OPERATING SUPPLIES	3,000	3,000	3,000	3,000	12,000.00
11	UA	11111	531401	OPERATING SUPPLIES	3,000	3,000	3,000	3,000	12,000.00
12	UA	11111	531411	NON-OPERATING SUPPLIES	2,000	2,000	2,000	2,000	8,000.00
13	UA	11111	532104	OUTSOURCED SERVICES - OTHER	150	150	150	150	600.00
14	UA	11111	591101	DEPRECIATION - MACHINES	35,880	35,335	35,334	35,335	141,882.68
15	UA	11111	512001	DIRECT - SOCIAL SECURITY	7,955	8,014	6,414	6,344	28,727.16
16	UA	11111	512002	DIRECT - UNEMPLOYMENT INSURANC	2,781	2,781	2,163	2,163	9,887.20
17	UA	11111	512005	DIRECT - MEDICAL	23,431	23,431	18,224	18,224	83,309.65
18	UA	11111	512006	DIRECT - LIFE INSURANCE	1,609	1,609	1,251	1,251	5,720.00
19	UA	11111	512101	INDIRECT - SOCIAL SECURITY	1,264	1,299	1,299	1,299	5,162.30
20	UA	11111	512102	INDIRECT - UNEMPLOYMENT INSUR	309	309	309	309	1,235.90
21	UA	11111	512105	INDIRECT - MEDICAL	2,603	2,603	2,603	2,603	10,413.71
22	UA	11111	512106	INDIRECT - LIFE INSURANCE	179	179	179	179	715.00
23	UA	11111	512201	DIRECT - 401K	7,330	7,385	5,911	5,846	26,471.80
24	UA	11111	512301	INDIRECT - 401K	1,165	1,197	1,197	1,197	4,757.01
25	UA	11121	503201	LABOR ABSORPTION	(234,120.99)	(219,016)	(200,136)	(203,912)	(857,184.90)
26	UA	11121	511001	SALARY & WAGE - DIRECT LABOR	203,945.14	190,787	174,340	177,630	746,702.36
27	UA	11121	511003	VACATION - DIRECT LABOR	2,858.81	2,240	2,046	2,085	9,229.84
28	UA	11121	511007	SAL&WAGE PREMIUM-DIRECT LABOR	2,970.07	2,327	2,126	2,166	9,589.07
29	UA	11121	511101	SALARY & WAGE - INDIRECT LABOR	22,851.00	23,536	23,536	23,536	93,459.00
30	UA	11121	511107	SAL&WAGE PREMIUM-INDIRECT LAB	200.00	200	200	200	800.00
31	UA	11121	520001	TRAVEL EXPENSE - TRANSPORT AIR	500.00	500			1,000.00
32	UA	11121	520003	TRAVEL EXPENSE -ACCOMODATIONS	500.00	500			1,000.00
33	UA	11121	520004	TRAVEL EXPENSE -MEALS	250.00	250			500.00
34	UA	11121	531012	REPAIR & MAINTENANCE - MACH	350.00	350	350	350	1,400.00
35	UA	11121	531013	REPAIR & MAINTENANCE	1,000.00	1,000	1,000	1,000	4,000.00
36	UA	11121	531303	OFFICE SUPPLIES	50.00	50	50	50	200.00
37	UA	11121	531399	CHEMICAL - OPERATING SUPPLIES	1,000.00	1,000	1,000	1,000	4,000.00
38	UA	11121	531400	PAINT - OPERATING SUPPLIES	250.00	250	250	250	1,000.00
39	UA	11121	531401	OPERATING SUPPLIES	3,500.00	3,500	3,500	3,500	14,000.00
40	UA	11121	531404	OUTSIDE OPERATION EXPENSES	5,000.00	5,000	5,000	5,000	20,000.00
41	UA	11121	531411	NON-OPERATING SUPPLIES	2,500.00	2,500	2,500	2,500	10,000.00
42	UA	11121	552201	FREIGHT - OUTBOUND	500.00	500	500	500	2,000.00
43	UA	11121	591101	DEPRECIATION - MACHINES	29,439.00	29,439	29,439	29,057	117,374.00
44	UA	11121	512001	DIRECT - SOCIAL SECURITY	16,047.71	14,945	13,656	13,914	58,562.38
45	UA	11121	512002	DIRECT - UNEMPLOYMENT INSURANC	5,870.53	5,871	5,871	5,871	23,482.10
46	UA	11121	512005	DIRECT - MEDICAL	49,465.11	49,465	49,465	49,465	197,860.43
47	UA	11121	512006	DIRECT - LIFE INSURANCE	3,396.25	3,396	3,396	3,396	13,585.00
48	UA	11121	512101	INDIRECT - SOCIAL SECURITY	1,763.40	1,816	1,816	1,816	7,210.81
49	UA	11121	512102	INDIRECT - UNEMPLOYMENT INSUR	617.95	618	618	618	2,471.80
50	UA	11121	512105	INDIRECT - MEDICAL	5,206.85	5,207	5,207	5,207	20,827.41
51	UA	11121	512106	INDIRECT - LIFE INSURANCE	357.50	358	358	358	1,430.00
52	UA	11121	512201	DIRECT - 401K	14,787.81	13,771	12,584	12,822	53,964.66
53	UA	11121	512301	INDIRECT - 401K	1,624.96	1,673	1,673	1,673	6,644.69
54	UC	11123	502104	OTH NON-OH EXP - TAXES	750.00	750	750	750	3,000.00
Data

 

[GlennUK]

It looks like a simple copy of data ... maybe. I know you want the value from D5 copied as a column value into the target area, column B. So columns B:H of source area copy to columns C:I of the target area. Where does column A of the target area come from?

 

[Kim B]

It is just a copy function, it's just that I don't want to have to copy 100 budgets one at a time and I knew a macro would do it. column A is just the department number which shows in d:5. So it isn't important for what I am trying to do. i thought it would be easier to pull from d5, although each budget will have the department number in it column A

Thanks

 

[GlennUK]

Account and description appear to be going into cols C and D of your target sheet. You say the department number is going into column A ( from D5 ). In that case what goes into column B of your target sheet?

 

[Kim B]

Sorry for the confusion, column A hold the department number in the budget worksheet which is the same department number as column B in the data worksheet. d5 doesn't have to be used. I just thought it would be easier. Maybe not, as and alternative, column A in the budget sheet does store the dept number as well.

Thanks

 

[GlennUK]

Here's a guess, that would be a good starting point for you:

Sub multicopy()
    ' get first file
    fname = Dir("g:\accounting\private\msdacct\planning\2011\budgets\budgets reviewed\*.xl*")
    Do Until fname = ""
        Workbooks.Open (fname)
        lastrow = ActiveWorkbook.Sheets(1).Range("B65536").End(xlUp).Row
        targetrow = ThisWorkbook.Sheets(1).Range("B65536").End(xlUp).Offset(1).Row
        ActiveWorkbook.Sheets(1).Range("B9:H" & lastrow).Copy _
            Destination:=ThisWorkbook.Sheets(1).Range("B" & targetrow)
        ThisWorkbook.Sheets(1).Range("A" & targetrow).Resize(targetrow - 9 + 1).Value = _
            ActiveWorkbook.Sheets(1).Range("D5").Value
        ActiveWorkbook.Close savechanges:=False
        fname = Dir
    Loop
        
End Sub

 

[Kim B]

Thanks, just one quick note, the summary sheet will rest in another directory labeled g:\accounting\private\msdacct\planning\2012\budget entry. Sorry for that oversight.

Also I will not have the opportunity to test this for a bit, so if you don't hear from me, please do not think i am ungrateful.

thanks again.

 

[Kim B]

Great start!!

I am getting a run time error 1004:application defined or object defined error on this line. Also the budget info is on a tab labeled budget. There are other tabs in the budget worksheets. And it is only picking up the first budget in the directory, maybe the error has something to do with that.

Sub multicopy()
' get first file
fname = Dir("g:\accounting\private\msdacct\planning\2011\plan\budgets\budgets reviewed\*.xl*")
Do Until fname = ""
Workbooks.Open (fname)
lastrow = ActiveWorkbook.Sheets(1).Range("B65536").End(xlUp).Row
targetrow = ThisWorkbook.Sheets(1).Range("B65536").End(xlUp).Offset(1).Row
ActiveWorkbook.Sheets(1).Range("B9:H" & lastrow).Copy _
Destination:=ThisWorkbook.Sheets(1).Range("B" & targetrow)
ThisWorkbook.Sheets(1).Range("A" & targetrow).Resize(targetrow - 9 + 1).Value = _
ActiveWorkbook.Sheets(1).Range("D5").Value
ActiveWorkbook.Close savechanges:=False
fname = Dir
Loop

End Sub

Thanks again

 

[GlennUK]

When the error occurs, can you go into Debug mode and hover the mouse over the targetrow variable? What does the tooltip say when you do that?

... EDIT: change targetrow-9+1 to lastrow-9+1. ( sorry this was edited twice )

As for selecting a particular sheet when the budget workbooks open, maybe a line of:
Sheets("Budget").Select
is needed after the Workbook Open statement.

 

[Kim B]

Even though I changed the code to pick only the budget tab, it still looks at the instructions tab and doesn't seem to be picking up the $ columns.


Here is the result

Sheet2


<TABLE style="BACKGROUND-COLOR: #ffffff; PADDING-LEFT: 2pt; PADDING-RIGHT: 2pt; FONT-FAMILY: Tahoma,Arial; FONT-SIZE: 10pt" border=1 cellSpacing=0 cellPadding=0><COLGROUP><COL style="WIDTH: 30px; FONT-WEIGHT: bold"><COL style="WIDTH: 129px"><COL style="WIDTH: 323px"><COL style="WIDTH: 80px"><COL style="WIDTH: 81px"><COL style="WIDTH: 141px"></COLGROUP><TBODY><TR style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt; FONT-WEIGHT: bold"><TD></TD><TD>A</TD><TD>B</TD><TD>C</TD><TD>D</TD><TD>E</TD></TR><TR style="HEIGHT: 16px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">2</TD><TD style="TEXT-ALIGN: left; FONT-FAMILY: Arial Unicode MS">A CHIASSON</TD><TD></TD><TD>A CHIASSON</TD><TD style="TEXT-ALIGN: right">41105</TD><TD>APPS MIDWEST - IL</TD></TR><TR style="HEIGHT: 16px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">3</TD><TD style="TEXT-ALIGN: left; FONT-FAMILY: Arial Unicode MS">A CHIASSON</TD><TD>Based upon the information, enter 2011 budget amounts for each account each quarter. Formulas may be used if desired.</TD><TD>A CHIASSON</TD><TD style="TEXT-ALIGN: right">41106</TD><TD>APPS SOUTH - NC</TD></TR><TR style="HEIGHT: 16px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">4</TD><TD style="TEXT-ALIGN: left; FONT-FAMILY: Arial Unicode MS">A CHIASSON</TD><TD></TD><TD>A CHIASSON</TD><TD style="TEXT-ALIGN: right">41107</TD><TD>APPS SOUTH - TN</TD></TR><TR style="HEIGHT: 16px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">5</TD><TD style="TEXT-ALIGN: left; FONT-FAMILY: Arial Unicode MS">A CHIASSON</TD><TD>If there are additional accounts needed for the department, they can be entered in rows 112-121 using the drop down list.</TD><TD>A CHIASSON</TD><TD style="TEXT-ALIGN: right">41108</TD><TD>APPS SOUTH - TX</TD></TR><TR style="HEIGHT: 16px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">6</TD><TD style="TEXT-ALIGN: left; FONT-FAMILY: Arial Unicode MS">A CHIASSON</TD><TD style="FONT-FAMILY: ">If "duplicate" appears in the YTD column after selecting an additional account, it means the account is already present; reselect "ADD NEW ACCOUNT".</TD><TD>A CHIASSON</TD><TD style="TEXT-ALIGN: right">41109</TD><TD>APPS WEST - WA</TD></TR><TR style="HEIGHT: 16px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">7</TD><TD style="TEXT-ALIGN: left; FONT-FAMILY: Arial Unicode MS">A CHIASSON</TD><TD>The "LX Account Listing" tab may be used to find the desired account.</TD><TD>A CHIASSON</TD><TD style="TEXT-ALIGN: right">41111</TD><TD>APPS WEST - CA</TD></TR><TR style="HEIGHT: 16px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">8</TD><TD style="TEXT-ALIGN: left; FONT-FAMILY: Arial Unicode MS">A CHIASSON</TD><TD></TD><TD>A CHIASSON</TD><TD style="TEXT-ALIGN: right">44301</TD><TD>APPLICATIONS - ARMS</TD></TR><TR style="HEIGHT: 16px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">9</TD><TD style="TEXT-ALIGN: left; FONT-FAMILY: Arial Unicode MS">A CHIASSON</TD><TD>Enter quarterly headcount in rows 134-135. This will populate the payroll accounts listed in rows 122-131.</TD><TD>A CHIASSON</TD><TD style="TEXT-ALIGN: right">52201</TD><TD>SALES AFTERMARKET</TD></TR><TR style="HEIGHT: 16px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">10</TD><TD style="TEXT-ALIGN: left; FONT-FAMILY: Arial Unicode MS">A CHIASSON</TD><TD></TD><TD>A STEIGER</TD><TD style="TEXT-ALIGN: right">28106</TD><TD>FACILITY - NC</TD></TR><TR style="HEIGHT: 16px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">11</TD><TD style="TEXT-ALIGN: left; FONT-FAMILY: Arial Unicode MS">A CHIASSON</TD><TD>Note for production departments only: Enter information in yellow in the "Production Worksheet" tab.</TD><TD>A STEIGER</TD><TD style="TEXT-ALIGN: right">51101</TD><TD>SALES EAST - RI</TD></TR><TR style="HEIGHT: 16px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">12</TD><TD style="TEXT-ALIGN: left; FONT-FAMILY: Arial Unicode MS">A CHIASSON</TD><TD>This tab calculates the "For Budget Entry" section, which is to be entered in the "Budget" tab.</TD><TD>A STEIGER</TD><TD style="TEXT-ALIGN: right">51106</TD><TD>SALES SOUTH - NC</TD></TR><TR style="HEIGHT: 16px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">13</TD><TD style="TEXT-ALIGN: left; FONT-FAMILY: Arial Unicode MS">A CHIASSON</TD><TD></TD><TD>A STEIGER</TD><TD style="TEXT-ALIGN: right">55101</TD><TD>SALES - LEICA - RI</TD></TR><TR style="HEIGHT: 16px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">14</TD><TD style="TEXT-ALIGN: left; FONT-FAMILY: Arial Unicode MS">A CHIASSON</TD><TD>Enter the applicable quarterly allocation percentages for the department in rows 138-146.</TD><TD>A STEIGER</TD><TD style="TEXT-ALIGN: right">55301</TD><TD>SALES - ARMS - RI</TD></TR></TBODY></TABLE>


Excel tables to the web >> http://www.excel-jeanie-html.de/index.php?f=1" target="_blank"> Excel Jeanie HTML 4

here is the code
Sub multicopy()
' get first file
fname = Dir("g:\accounting\private\msdacct\planning\2011\plan\budgets\budgets reviewed\*.xl*")
Do Until fname = ""
Workbooks.Open (fname)
Sheets("Budget").Select
lastrow = ActiveWorkbook.Sheets(1).Range("B65536").End(xlUp).Row
targetrow = ThisWorkbook.Sheets(1).Range("B65536").End(xlUp).Offset(1).Row
ActiveWorkbook.Sheets(1).Range("B9:H" & lastrow).Copy _
Destination:=ThisWorkbook.Sheets(1).Range("B" & targetrow)
ThisWorkbook.Sheets(1).Range("A" & targetrow).Resize(lastrow - 9 + 1).Value = _
ActiveWorkbook.Sheets(1).Range("D5").Value
ActiveWorkbook.Close savechanges:=False
fname = Dir
Loop

End Sub