Visit my Youtube Channel
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