Calling Subs and Functions

Note: This webpage is designed to accompany the Youtube video posted above. The video offers detailed explanation on all topics; while this webpage will serve as a repository for the code presented in the video.

Today, we are going to talk about calling Sub-Procedures and Functions to make your code smarter and more manageable.

In this video, we will first deep dive into the Theory of Subs and Functions, so that we are all on the same page. Then, we will convert an existing Single Sub into separate Subs and Functions. The objective will be for you to understand the usage of Child Subs and Functions confidently by the time we reach the end of this macro.

And Lastly, we will look at how to tackle error handling in scenarios whether there are multiple layers of sub-procedures.

Deep Dive Code

Sub RunMyCode_SingleSub()
    
    Dim sFileName As String
    sFileName = wsConsole.Range("B2").Value
    Workbooks.Open (sFileName)
    
End Sub

Sub RunMyCode_MultiSub()
    
    Dim sFileName As String
    sFileName = GetFileName
    OpenAFile sFileName
    
End Sub

Sub OpenAFile(FileToOpen As String)

    Workbooks.Open (FileToOpen)
    
End Sub

Function GetFileName() As String

    GetFileName = wsConsole.Range("B2").Value

End Function

Example – Original Single Sub

Sub ImportAndSaveOriginal()

    'Clear Worksheet Values
    wsInput.Cells.Clear
    wsSort.Cells.Clear
    wsSort.Range("A1").Value = "Date"
    wsSort.Range("B1").Value = "Docket"
    wsSort.Range("C1").Value = "Value"
    wsSort.Range("E1").Value = "Value"
    
    'Get Input File Name from Worksheet
    Dim sFileName As String
    sFileName = wsConsole.Range("B2").Value
       
    'Check If Input File Exists
    If Dir(sFileName) = "" Then
        MsgBox "Input File doesn't exist"
        Exit Sub
    End If
    
    'Copy Data from Input File
    Dim wb As Workbook
    Set wb = Workbooks.Open(sFileName)
    wb.Sheets("Sheet1").Range("A1").CurrentRegion.Copy wsInput.Range("A1")
    wb.Close savechanges:=False
    
    'Get Output Folder
    Dim sOutputFolder As String
    sOutputFolder = wsConsole.Range("B3").Value
    
    'Clear Output Folder
    If Dir(sOutputFolder, vbDirectory) <> "" Then
        If Dir(sOutputFolder & "*.xlsx") <> "" Then
            Kill sOutputFolder & "*.xlsx*"
        End If
        Else
        MkDir sOutputFolder
    End If
    
    'Get Prefix for Output File Name
    Dim currentDate As Date
    currentDate = wsInput.Range("A2").Value
    Dim sFilePrefix As String
    sFilePrefix = MonthName(Month(currentDate), True) & "-" & CStr(Year(currentDate)) & "-"
    
    'For Advanced Filter, determine Data Range and Copy To Range
    Dim rngList As Range, rngCopyTo As Range
    Set rngList = wsInput.Range("A1").CurrentRegion
    Set rngCopyTo = wsSort.Range("A1:C1")
    
    Dim rngCriteria As Range
    Dim sOutputFileName As String
    'Set Criteria Range
    wsSort.Range("E2").Value = ">0"
    Set rngCriteria = wsSort.Range("E1:E2")
    
    'Sort for Invoice Data
    rngList.AdvancedFilter xlFilterCopy, rngCriteria, rngCopyTo
    Set rngCriteria = Nothing
     
    'Save Invoice Data in New File
    
    sOutputFileName = sOutputFolder & sFilePrefix & "Invoices"
    Set wb = Workbooks.Add
    wsSort.Range("A1").CurrentRegion.Copy wb.Sheets(1).Range("A1")
    wb.SaveAs sOutputFileName
    wb.Close savechanges:=False
    Set wb = Nothing

    'Set Criteria Range, Sort for Credit Data
    wsSort.Range("E2").Value = "<0"
    Set rngCriteria = wsSort.Range("E1:E2")
    rngList.AdvancedFilter xlFilterCopy, rngCriteria, rngCopyTo
    Set rngCriteria = Nothing
       
    'Save Credit Data in New File
    sOutputFileName = sOutputFolder & sFilePrefix & "Credits"
    Set wb = Workbooks.Add
    wsSort.Range("A1").CurrentRegion.Copy wb.Sheets(1).Range("A1")
    wb.SaveAs sOutputFileName
    wb.Close savechanges:=False
    Set wb = Nothing

End Sub

Example – Refactored Multi Sub

Parent Macro

Sub ImportAndSaveRefactored()

    'Clear Worksheet Values
    ClearWorksheetValues
    
    'Get Input File Name from Worksheet
    Dim sFileName As String
    sFileName = GetInputFileName()
       
    'Check If Input File Exists
    If Not InputFileExists(sFileName) Then
        MsgBox "Input File doesn't exist"
        Exit Sub
    End If
    
    'Copy Data from Input File
    CopyAndPasteDataFromInputFile sFileName
    
    'Get Output Folder
    Dim sOutputFolder As String
    sOutputFolder = GetOutputFolderName()
    
    'Clear Output Folder
    ClearOutputFolder sOutputFolder
    
    'Get Prefix for Output File Name
    Dim sFilePrefix As String
    sFilePrefix = GetPrefixForOutputFileName()
    
    'For Advanced Filter, determine Data Range and Copy To Range
    Dim rngList As Range, rngCopyTo As Range
    Set rngList = GetDataRangeForAdvancedFilter()
    Set rngCopyTo = GetCopyToRangeForAdvancedFilter()
    
    Dim rngCriteria As Range
    Dim sOutputFileName As String
    'Set Criteria Range
    Set rngCriteria = GetCriteriaRangeForAdvancedFilter(">0")
    
    'Sort for Invoice Data
    SortDataUsingAdvancedFilter rngList, rngCopyTo, rngCriteria
    Set rngCriteria = Nothing
     
    'Save Invoice Data in New File
    sOutputFileName = ConstructOutputFileName(sOutputFolder, sFilePrefix, "Invoices")
    SaveOutputFile sOutputFileName

    'Set Criteria Range, Sort for Credit Data
    Set rngCriteria = GetCriteriaRangeForAdvancedFilter("<0")
    
    'Sort for Credit Data
    SortDataUsingAdvancedFilter rngList, rngCopyTo, rngCriteria
    Set rngCriteria = Nothing
     
    'Save Credit Data in New File
    sOutputFileName = ConstructOutputFileName(sOutputFolder, sFilePrefix, "Credits")
    SaveOutputFile sOutputFileName

End Sub

Supporting Child Subs

Sub ClearWorksheetValues()
    wsInput.Cells.Clear
    wsSort.Cells.Clear
    wsSort.Range("A1").Value = "Date"
    wsSort.Range("B1").Value = "Docket"
    wsSort.Range("C1").Value = "Value"
    wsSort.Range("E1").Value = "Value"
End Sub


Function GetInputFileName() As String
    GetInputFileName = wsConsole.Range("B2").Value
End Function

Function InputFileExists(sfFileName As String) As Boolean
    If Dir(sfFileName) = "" Then
        InputFileExists = False
    Else
        InputFileExists = True
    End If

End Function


Sub CopyAndPasteDataFromInputFile(sfFileName As String)
    Dim wb As Workbook
    Set wb = Workbooks.Open(sfFileName)
    wb.Sheets("Sheet1").Range("A1").CurrentRegion.Copy wsInput.Range("A1")
    wb.Close savechanges:=False
End Sub

Function GetOutputFolderName() As String
    GetOutputFolderName = wsConsole.Range("B3").Value
End Function

Sub ClearOutputFolder(sfOutputFolder As String)
    If Dir(sfOutputFolder, vbDirectory) <> "" Then
        If Dir(sfOutputFolder & "*.xlsx") <> "" Then
            Kill sfOutputFolder & "*.xlsx*"
        End If
        Else
        MkDir sfOutputFolder
    End If
End Sub

Function GetPrefixForOutputFileName() As String
    Dim currentDate As Date
    currentDate = wsInput.Range("A2").Value
    GetPrefixForOutputFileName = MonthName(Month(currentDate), True) & "-" & CStr(Year(currentDate)) & "-"
End Function

Function GetDataRangeForAdvancedFilter() As Range
    Set GetDataRangeForAdvancedFilter = wsInput.Range("A1").CurrentRegion
End Function

Function GetCopyToRangeForAdvancedFilter() As Range
    Set GetCopyToRangeForAdvancedFilter = wsSort.Range("A1:C1")
End Function

Function GetCriteriaRangeForAdvancedFilter(sfCriteria As String) As Range
    wsSort.Range("E2").Value = sfCriteria
    Set GetCriteriaRangeForAdvancedFilter = wsSort.Range("E1:E2")
End Function

Sub SortDataUsingAdvancedFilter(sfRngList As Range, sfRngCopyTo As Range, _
                sfCriteriaRange As Range)
      sfRngList.AdvancedFilter xlFilterCopy, sfCriteriaRange, sfRngCopyTo
End Sub

Function ConstructOutputFileName(sfOutputFolder As String, sfFilePrefix As String, _
                sfFileType As String)
       ConstructOutputFileName = sfOutputFolder & sfFilePrefix & sfFileType
End Function

Sub SaveOutputFile(sfOutputFileName As String)
    Dim wb As Workbook
    Set wb = Workbooks.Add
    wsSort.Range("A1").CurrentRegion.Copy wb.Sheets(1).Range("A1")
    wb.SaveAs sfOutputFileName
    wb.Close savechanges:=False
    Set wb = Nothing
End Sub