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
