Dear Sirs,
I have a macro which updates my monthly trial balance. But it's too long. Takes time to process. I want to shorten it particularly step 1, step 3 & step 4, using loop which i am not very good at. Please help how to shorten my codes. Below is my macro. Thank you. DanJ STEP 1 Sub OPEN_SCHEDULES() ChDir "C:\TRABAJOKO\2011-FINANCIALS\WTB\OCTOBER\Schedules" Workbooks.Open Filename:= _ "C:\TRABAJOKO\2011-FINANCIALS\WTB\OCTOBER\Schedules\Cash Disbursement Schedule.xls" Windows("Cash Disbursement Schedule.xls").Activate Call Autofill Workbooks.Open Filename:= _ "C:\TRABAJOKO\2011-FINANCIALS\WTB\OCTOBER\Schedules\Cash Receipt Schedule.xls" Windows("Cash Receipt Schedule.xls").Activate Call Autofill Workbooks.Open Filename:= _ "C:\TRABAJOKO\2011-FINANCIALS\WTB\OCTOBER\Schedules\Cash Settlement Schedule.xls" Windows("Cash Settlement Schedule.xls").Activate Call Autofill Workbooks.Open Filename:= _ "C:\TRABAJOKO\2011-FINANCIALS\WTB\OCTOBER\Schedules\Journal Voucher Schedule.xls" Windows("Journal Voucher Schedule.xls").Activate Call Autofill Workbooks.Open Filename:= _ "C:\TRABAJOKO\2011-FINANCIALS\WTB\OCTOBER\Schedules\Loan Amortization Schedule.xls" Windows("Loan Amortization Schedule.xls").Activate Call Autofill Workbooks.Open Filename:= _ "C:\TRABAJOKO\2011-FINANCIALS\WTB\OCTOBER\Schedules\Loan Disbursement Schedule.xls" Windows("Loan Disbursement Schedule.xls").Activate Call Autofill Workbooks.Open Filename:= _ "C:\TRABAJOKO\2011-FINANCIALS\WTB\OCTOBER\Schedules\System Journal Voucher Schedule.xls" Windows("System Journal Voucher Schedule.xls").Activate Call Autofill 'Open Working Trial Balance Workbooks.Open Filename:= _ "C:\TRABAJOKO\2011-FINANCIALS\WTB\OCTOBER\WTB.xlsm" Windows("WTB.xlsm").Activate End Sub 'STEP 2 Sub Autofill() 'Selects column F range("A1").Select Columns("f:f").Select Selection.Insert Shift:=xlToRight range("F2").Select 'Concatenates columns D & E on Cell F2 Selection.FormulaR1C1 = "=RC[-1]&RC[-2]" range("F2").Autofill Destination:=range("F2:F" & range("E" & Rows.Count).End(xlUp).Row) 'Type:=xlFillDefault Columns("j:j").Select Selection.Insert Shift:=xlToRight range("J2").Select Selection.FormulaR1C1 = "=+RC[-2]-RC[-1]" range("J2").Autofill Destination:=range("J2:J" & range("I" & Rows.Count).End(xlUp).Row) 'Type:=xlFillDefaultRange Dim Rng As range Dim h As range Set Rng = range("h1:h" & range("h1").End(xlDown).Row) Set C = range("h1").End(xlDown).Offset(1, 0) 'gets the sum of each column-H, I, & J C.Formula = "=SUM(" & Rng.Address(False, False) & ")" C.Copy C.Resize(1, 3) End Sub 'STEP 3 Sub UPDATE_WTB() ' 'This macro assumes that the WTB.xlsm file is open as well as the the ff. extracted files/schedules: Journal Voucher, 'Cash Disbursement, Loan Disbursement, Cash Receipt, Cash Settlement, Loan Amortization, and Sytem Journal Voucher. ' ' Windows("Journal Voucher Schedule.xls").Activate range("A2").Select range(Selection, Selection.End(xlDown)).Select range(Selection, Selection.End(xlToRight)).Select Selection.Copy Windows("WTB.xlsm").Activate Sheets("JVS").Select range("A2").Select ActiveSheet.Paste Application.CutCopyMode = False Windows("Cash Disbursement Schedule.xls").Activate range("A2").Select range(Selection, Selection.End(xlDown)).Select range(Selection, Selection.End(xlToRight)).Select Application.CutCopyMode = False Selection.Copy Windows("WTB.xlsm").Activate Sheets("CDS").Select range("A2").Select ActiveSheet.Paste Application.CutCopyMode = False Windows("Loan Disbursement Schedule.xls").Activate range("A2").Select range(Selection, Selection.End(xlDown)).Select range(Selection, Selection.End(xlToRight)).Select Selection.Copy Windows("WTB.xlsm").Activate Sheets("LDS").Select range("A2").Select ActiveSheet.Paste Application.CutCopyMode = False Windows("Cash Receipt Schedule.xls").Activate range("A2").Select range(Selection, Selection.End(xlDown)).Select range(Selection, Selection.End(xlToRight)).Select Selection.Copy Windows("WTB.xlsm").Activate Sheets("PCTB").Select range("A2").Select ActiveSheet.Paste Application.CutCopyMode = False Windows("Cash Settlement Schedule.xls").Activate range("A2").Select range(Selection, Selection.End(xlDown)).Select range(Selection, Selection.End(xlToRight)).Select Selection.Copy Windows("WTB.xlsm").Activate Sheets("CSS").Select range("A2").Select ActiveSheet.Paste Application.CutCopyMode = False Windows("Loan Amortization Schedule.xls").Activate range("A2").Select range(Selection, Selection.End(xlDown)).Select range(Selection, Selection.End(xlToRight)).Select Selection.Copy Windows("WTB.xlsm").Activate Sheets("LAS").Select range("A2").Select ActiveSheet.Paste Application.CutCopyMode = False Windows("System Journal Voucher Schedule.xls").Activate range("A2").Select range(Selection, Selection.End(xlDown)).Select range(Selection, Selection.End(xlToRight)).Select Selection.Copy Windows("WTB.xlsm").Activate Sheets("SJVS").Select range("A2").Select ActiveSheet.Paste Application.CutCopyMode = False End Sub 'STEP 4 Sub Close_Schedules() '*schedules.xls 'Close all "*Schedules.xls" files without save Windows("Cash Disbursement Schedule.xls").Activate ActiveWorkbook.Close False Windows("Cash Receipt Schedule.xls").Activate ActiveWorkbook.Close False Windows("Cash Settlement Schedule.xls").Activate ActiveWorkbook.Close False Windows("Journal Voucher Schedule.xls").Activate ActiveWorkbook.Close False Windows("Loan Amortization Schedule.xls").Activate ActiveWorkbook.Close False Windows("Loan Disbursement Schedule.xls").Activate ActiveWorkbook.Close False Windows("System Journal Voucher Schedule.xls").Activate ActiveWorkbook.Close False End Sub Sub Update_Monthly_WTB() Application.ScreenUpdating = False Call OPEN_SCHEDULES Call UPDATE_WTB Call Close_Schedules Application.ScreenUpdating = True End Sub -- ---------------------------------------------------------------------------------- Some important links for excel users: 1. Follow us on TWITTER for tips tricks and links : http://twitter.com/exceldailytip 2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310 3. Excel tutorials at http://www.excel-macros.blogspot.com 4. Learn VBA Macros at http://www.quickvba.blogspot.com 5. Excel Tips and Tricks at http://exceldailytip.blogspot.com To post to this group, send email to excel-macros@googlegroups.com <><><><><><><><><><><><><><><><><><><><><><> Like our page on facebook , Just follow below link http://www.facebook.com/discussexcel