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

Reply via email to