Reviewing Code

**AnthonyWB** · 08-20-2010, 09:58 AM

Hello everyone. This is not a specific programming questions. I have started to finish an automation project. I was wondering if someone with solid VBA experience would be interested in reviewing my code. The code spans several modules and comprises approximately 2,000 lines of written code. Most of that code is repetitious and I suspect a more senior programmer could provide hints, suggestions or even ways to condense the code so that it is more readable and more effecitent. It would be greatly appreciated and improve my VBA skills. Note that the code does not "fit" into the Excel forums space requirements. Thanks.

**StephenR** · 08-20-2010, 10:07 AM

Is that 2,000 or 20,000?! Can you post a sample of a bit you think could be improved. I doubt anyone will undertake to look through that much code, at least not for free!

**AnthonyWB** · 08-20-2010, 10:24 AM

Here is some of the code: This is a small chunk. I am sure this can be trimmed down.

    Dim fDate            As String
    Dim fPath            As String
    Dim fDatePrevious1   As String
    Dim fDatePrevious2   As String
    Dim fDatePrevious3   As String
    Dim fPriorDate1      As String
    Dim fPriorDate2      As String
    Dim fPriorDate3      As String
    
    Sub CreateFolder()
'***********************************************************************
'CreateFolder() macro creates the folders for the 157 Automation process.
'***********************************************************************

    Dim Fldr   As String
    Dim ErrBuf As String

    fDate = Application.InputBox("Enter a date in the format shown:", "Date to add...", Format(Date, "DD-MMM-YYYY"))
    If fDate = "False" Then Exit Sub
    
    fDatePrevious1 = DateSerial(Year(fDate), Month(fDate), 0)
    fPriorDate1 = Format(fDatePrevious1, "DD-MMM-YYYY")
    
    fDatePrevious2 = DateSerial(Year(fDate), Month(fDate) - 1, 0)
    fPriorDate2 = Format(fDatePrevious2, "DD-MMM-YYYY")
    
    fDatePrevious3 = DateSerial(Year(fDate), Month(fDate) - 2, 0)
    fPriorDate3 = Format(fDatePrevious3, "DD-MMM-YYYY")
       
    fPath = "L:\"
    
    On Error GoTo ErrorHandler
        
        Fldr = fPath & fDate & "_157"
        MkDir Fldr
        
        Fldr = fPath & fPriorDate1 & "_157"
        MkDir Fldr
        
        Fldr = fPath & fPriorDate2 & "_157"
        MkDir Fldr
        
        Fldr = fPath & fDate & "_157\" & "157_Reports"
        MkDir Fldr
        
        Fldr = fPath & fPriorDate1 & "_157\" & "157_Reports"
        MkDir Fldr
        
        Fldr = fPath & fPriorDate2 & "_157\" & "157_Reports"
        MkDir Fldr
        
        Fldr = fPath & fDate & "_157\" & "157_Reports\" & "Roll_forward_wTA"
        MkDir Fldr
        
        Fldr = fPath & fPriorDate1 & "_157\" & "157_Reports\" & "Roll_forward_wTA"
        MkDir Fldr
        
        Fldr = fPath & fPriorDate2 & "_157\" & "157_Reports\" & "Roll_forward_wTA"
        MkDir Fldr
               
        Fldr = fPath & fDate & "_157\" & "157_Reports\" & "Terminated"
        MkDir Fldr
                      
        Fldr = fPath & fPriorDate1 & "_157\" & "157_Reports\" & "Terminated"
        MkDir Fldr
        
        Fldr = fPath & fPriorDate2 & "_157\" & "157_Reports\" & "Terminated"
        MkDir Fldr
                      
        Fldr = fPath & fDate & "_157\" & "157_Reports\" & "IBRD_Disclosure"
        MkDir Fldr
        
        'Fldr = fPath & fPriorDate1 & "_157\" & "157_Reports\" & "IBRD_Disclosure"
        'MkDir Fldr
        
        'Fldr = fPath & fPriorDate2 & "_157\" & "157_Reports\" & "IBRD_Disclosure"
        'MkDir Fldr
        
        Fldr = fPath & fDate & "_157\" & "105_Reports"
        MkDir Fldr
        
        Fldr = fPath & fPriorDate1 & "_157\" & "105_Reports"
        MkDir Fldr
        
        Fldr = fPath & fPriorDate2 & "_157\" & "105_Reports"
        MkDir Fldr
    
    If Len(ErrBuf) > 0 Then MsgBox "The following folders already existed:" & vbLf & vbLf & ErrBuf
    
    Exit Sub
    
ErrorHandler:
    ErrBuf = ErrBuf & vbLf & Fldr
    Resume Next
    
End Sub
Sub Move_157_Disclosure_1()
    
    Dim fso
    Dim sfol As String
    Dim dfol As String
    
    FileCopy "L:\" & fPriorDate3 & "_157\" & "157_Reports\IBRD_Disclosure\157_Disclosure.xlsm", "L:\" & fDate & "_157\" & "157_Reports\IBRD_Disclosure\157_Disclosure.xlsm"

End Sub
Sub Create_Prior_Quarter_105()
    Dim sPath1      As String
    Dim sPath2      As String
    Const sFileInp1 As String = "105.xlsm"
    Const sFileOut1 As String = "Prior_Quarter_105.xlsm"
    Dim wb1         As Workbook
    Dim wb2         As Workbook
    
    sPath1 = fPath & fPriorDate3 & "_157\" & "105_Reports\"
    sPath2 = fPath & "157_Support_Summaries\"
    
    Set wb1 = Workbooks.Open(sPath1 & sFileInp1)
    
        ActiveWorkbook.SaveAs Filename:=sPath2 & sFileOut1, _
                       FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
                       CreateBackup:=False
                       
    wb1.Close SaveChanges:=True
    
End Sub
Sub Create_105_File_1()

Dim sPath1       As String
Const sFileOut1  As String = "105.xlsm"

sPath1 = fPath & fDate & "_157\105_Reports\"

Workbooks.Add
With ActiveSheet '105
    .Name = "105"
    .Parent.SaveAs Filename:=sPath1 & sFileOut1, _
                       FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
                       CreateBackup:=False
    .Parent.Close
End With

End Sub
Sub Create_105_File_2()

Dim sPath1       As String
Const sFileOut1  As String = "105.xlsm"

sPath1 = fPath & fPriorDate1 & "_157\105_Reports\"

Workbooks.Add
With ActiveSheet '105
    .Name = "105"
    .Parent.SaveAs Filename:=sPath1 & sFileOut1, _
                       FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
                       CreateBackup:=False
    .Parent.Close
End With

End Sub
Sub Create_105_File_3()

Dim sPath1       As String
Const sFileOut1  As String = "105.xlsm"

sPath1 = fPath & fPriorDate2 & "_157\105_Reports\"

Workbooks.Add
With ActiveSheet '105
    .Name = "105"
    .Parent.SaveAs Filename:=sPath1 & sFileOut1, _
                       FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
                       CreateBackup:=False
    .Parent.Close
End With

End Sub

Sub Create_Disclosure_Breakdown_Files()

    Dim sPath1       As String
    Dim sPath2       As String
    Dim sPath3       As String
    Const sFileOut1  As String = "105.xlsm"
    Const sFileOut2  As String = "IBRD"
    Const sFileOut3  As String = "Borrowing_Portfolio_Bonds"
    Const sFileOut4  As String = "Borrowing_Portfolio_Swaps"
    Const sFileOut5  As String = "Client_Operations"
    Const sFileOut6  As String = "IDA_Company"
    Const sFileOut7  As String = "Other_Equity"
    Const sFileOut8  As String = "IFFIMM_Company"
    Const sFileOut9  As String = "157_Disclosure"
    Const sFileOut10 As String = "IBRD_PriorQuarter_L3"
    Const sFileOut11 As String = "IBRD_CurrentQuarter_L3"
    Const sFileOut12 As String = "IBRD_L3_Hold"
    Const sFileOut13 As String = "BOND_Terminations"
    Const sFileOut14 As String = "CSWAP_Terminations"
    Const sFileOut15 As String = "ISWAP_Terminations"
      
    sPath1 = fPath & fDate & "_157\105_Reports\"
    sPath2 = fPath & fDate & "_157\157_Reports\IBRD_Disclosure\"
    sPath3 = fPath & fDate & "_157\157_Reports\Terminated\"
   
    'fPriorDate = Format(fDatePrevious, "DD-MMM-YYYY")
    
        
    Workbooks.Add 'Borrowing_Portfolio_Bonds
    With ActiveSheet
        .Parent.SaveAs Filename:=sPath2 & sFileOut3, _
                       FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
                       CreateBackup:=False
        .Parent.Close
    End With
    
    Workbooks.Add 'Borrowing_Portfolio_Swaps
    With ActiveSheet
        .Parent.SaveAs Filename:=sPath2 & sFileOut4, _
                       FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
                       CreateBackup:=False
        .Parent.Close
    End With
    
    Workbooks.Add 'Client_Operations
    With ActiveSheet
        .Parent.SaveAs Filename:=sPath2 & sFileOut5, _
                       FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
                       CreateBackup:=False
        .Parent.Close
    End With
    
    Workbooks.Add 'IDA_Company
    With ActiveSheet
        .Parent.SaveAs Filename:=sPath2 & sFileOut6, _
                       FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
                       CreateBackup:=False
        .Parent.Close
    End With
    
    Workbooks.Add 'Other_Equity
    With ActiveSheet
        .Parent.SaveAs Filename:=sPath2 & sFileOut7, _
                       FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
                       CreateBackup:=False
        .Parent.Close
    End With
    
    Workbooks.Add 'IFFIMM_Company
    With ActiveSheet
        .Parent.SaveAs Filename:=sPath2 & sFileOut8, _
                       FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
                       CreateBackup:=False
        .Parent.Close
    End With
    

        
    Workbooks.Add 'BOND_Terminations
    With ActiveSheet
        .Parent.SaveAs Filename:=sPath3 & sFileOut13, _
                       FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
                       CreateBackup:=False
        .Parent.Close
    End With
    
    Workbooks.Add 'CSWAP_Terminations
    With ActiveSheet
        .Parent.SaveAs Filename:=sPath3 & sFileOut14, _
                       FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
                       CreateBackup:=False
        .Parent.Close
    End With
    
    Workbooks.Add 'ISWAP_Terminations
    With ActiveSheet
        .Parent.SaveAs Filename:=sPath3 & sFileOut15, _
                       FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
                       CreateBackup:=False
        .Parent.Close
    End With
    
End Sub
          
End Sub

**T-J** · 08-20-2010, 12:24 PM

Subs Create_105_File_1, Create_105_File_2, Create_105_File_3 all do the same thing with a different string, so replace with a single Sub which takes a string argument(s)? and call by passing each string into it.

Likewise, in Sub Create_Disclosure_Breakdown_Files the bits where you Add and Save can be slimmed down the same way.