Boilerplate Excel VBA Functions module

'copy the content of this gist into a new module in VBA (get to VBA by pressing Alt+F11)
'you then have access to the functions below from anywhere else in your workbook VBA scripts
'these scrips can be found at jaykilleen.com on at http://jaykilleen.com/posts/boilerplate-excel-vba-functions-module

Option Explicit

Function get_last_row(sheet As Worksheet, column_number As Integer) As Long

  get_last_row = Sheets(sheet.Name).Cells(Rows.Count, column_number).End(xlUp).row

End Function
Function get_column_number(sheet As Worksheet, value As String, Optional row As Variant, Optional whole As Boolean) As Integer

  Dim looks As String

  If IsMissing(row) Then
    row = 1
  End If

  If whole = False Then
  get_column_number = Sheets(sheet.Name).Cells(row, 1).EntireRow.Find(What:=value, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).column
  Else
  get_column_number = Sheets(sheet.Name).Cells(row, 1).EntireRow.Find(What:=value, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).column
  End If

End Function
Function get_row_number(sheet As Worksheet, value As Variant, column As Integer) As Integer

  get_row_number = Sheets(sheet.Name).Cells(1, column).EntireColumn.Find(What:=value, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).row

End Function
Function find_in_array(FindMe As String, myArray() As String)

  Dim C As String
  Dim ItemFound As Boolean
  Dim MatchCase As Boolean

  MatchCase = False

  ' Perform search
  C = Chr$(1)
  ItemFound = InStr(1, C & Join(myArray, C) & C, C & FindMe & C, 1 + MatchCase)

  If ItemFound Then find_in_array = True

End Function

Function timestamp(time As String)

  timestamp = Format(Now(), "YYYYMMDDhhmmss")

End Function
Public Function InCollection(col As Collection, key As String) As Boolean
  Dim var As Variant
  Dim errNumber As Long

  InCollection = False
  Set var = Nothing

  Err.Clear
  On Error Resume Next
    var = col.Item(key)
    errNumber = CLng(Err.Number)
  On Error GoTo 0

  '5 is not in, 0 and 438 represent incollection
  If errNumber = 5 Then ' it is 5 if not in collection
    InCollection = False
  Else
    InCollection = True
  End If

End Function
Public Function CollectionToArray(myCol As Collection) As Variant

    Dim result  As Variant
    Dim cnt     As Long

    ReDim result(myCol.Count)
    For cnt = 0 To myCol.Count - 1
        result(cnt) = myCol(cnt + 1)
    Next cnt
    CollectionToArray = result

End Function
Function FinancialYearFromDate(dDate As Date) As Long

  Dim iMonth As Integer
  Dim iYear As Integer

  iMonth = Month(dDate)
  iYear = Year(dDate)

  If iMonth < 7 Then FinancialYearFromDate = iYear
  If iMonth >= 7 Then FinancialYearFromDate = iYear + 1

End Function
Function ThisFinancialQuarterFromDate(dDate As Date) As Long

  Dim iMonth As Integer
  Dim iYear As Integer

  iMonth = Month(dDate)
  iYear = Year(dDate)

  ' when data is 31st March 2017
  If iMonth < 4 Then ThisFinancialQuarterFromDate = iYear & 3
  ' when data is 30th June 2017
  If iMonth < 7 And iMonth > 4 Then ThisFinancialQuarterFromDate = iYear & 4
  ' when data is 30th September 2016
  If iMonth < 10 And iMonth > 7 Then ThisFinancialQuarterFromDate = (iYear + 1) & 1
  ' when data is 31st December 2016
  If iMonth <= 12 And iMonth > 10 Then ThisFinancialQuarterFromDate = (iYear + 1) & 2

End Function
Function LastFinancialQuarterFromDate(dDate As Date) As Long

  Dim iMonth As Integer
  Dim iYear As Integer

  iMonth = Month(dDate)
  iYear = Year(dDate)

  ' when data is 31st March 2017
  If iMonth < 4 Then LastFinancialQuarterFromDate = iYear & 2
  ' when data is 30th June 2017
  If iMonth < 7 And iMonth >= 4 Then LastFinancialQuarterFromDate = iYear & 3
  ' when data is 30th September 2016
  If iMonth < 10 And iMonth >= 7 Then LastFinancialQuarterFromDate = iYear & 4
  ' when data is 31st December 2016
  If iMonth <= 12 And iMonth >= 10 Then LastFinancialQuarterFromDate = (iYear + 1) & 1

End Function
Function DateFromString(sDay As String, sMonth As String, sYear As String) As Date

  DateFromString = DateValue(sDay & "/" & sMonth & "/" & sYear)

End Function
Function LastSavedTimeStamp() As String
  LastSavedTimeStamp = ActiveWorkbook.BuiltinDocumentProperties("Last Save Time")
End Function

Sub ShowLastSavedTimeStamp()
  Dim hours As Integer: hours = DateDiff("h", LastSavedTimeStamp, Now())
  Dim minutes As Integer: minutes = DateDiff("n", LastSavedTimeStamp, Now())
  Dim seconds As Integer: seconds = DateDiff("s", LastSavedTimeStamp, Now())
  MsgBox "This workbook was Last Saved at " & vbNewLine & LastSavedTimeStamp & " or " & hours & ":" & (minutes Mod 60) & ":" & (seconds Mod 60) & " ago"
End Sub
Public Function UserName()
    UserName = Environ$("UserName")
End Function
Function wsExists(wsName As String, Optional wb As Workbook) As Boolean

  Dim ws As Worksheet
  If wb Is Nothing Then Set wb = ThisWorkbook

  wsName = UCase(wsName)
  For Each ws In wb.Sheets
    If UCase(ws.Name) = wsName Then wsExists = True: Exit Function
  Next
End Function

Function wbLocalPath(ByRef wb As Workbook) As String

  Dim Ctr As Long
  Dim objShell As Object
  Dim UserProfilePath As String

  'Check if it looks like a OneDrive location
  If InStr(1, wb.FullName, "https://", vbTextCompare) > 0 Then

    'Replace forward slashes with back slashes
    wbLocalPath = Replace(wb.FullName, "/", "\")

    'Get environment path using vbscript
    Set objShell = CreateObject("WScript.Shell")
    UserProfilePath = objShell.ExpandEnvironmentStrings("%UserProfile%")

      'Trim OneDrive designators
    For Ctr = 1 To 6
        'Debug.Print wbLocalPath
       wbLocalPath = Mid(wbLocalPath, InStr(wbLocalPath, "\") + 1)
        'Debug.Print wbLocalPath
    Next

      'Construct the name
    wbLocalPath = UserProfilePath & "\OneDrive - USG Boral\" & wbLocalPath

  Else

    wbLocalPath = wb.FullName

  End If

  'Debug.Print "This Workbook.LocalPath is:"
  'Debug.Print wbLocalPath
  'Debug.Print "C:\Users\KilleenJ\OneDrive - USG Boral\50-59-AU-SIP\50-Excel-Application\ <- Do They Look Similar"

End Function