Loading...
 
JoiWiki » Developer » MS Office » VBA Snippets » VBA Common Methods VBA Common Methods

VBA Common Methods

 

Alright, I know - they're not actually 'methods' in VBA, they're referred to as subs or functions, but you know what I mean. Here is a selection of methods which I've found useful to throw into a new module on an excel spreadsheet from time to time to enable a few things that I like to do quickly, the only difference between the code on this page and the others under VBA Snippets are that these are all pretty quick and simple and can be grabbed en masse. Here we go:

 

Date Functions

 Date functions have been the bane of my existence whilst coding pension calculations and especially where you're transposing onto a VBA system the dates in any spreadsheet proforma may as well use VBA functions rather than horrible to write and read cell formulae to get to where they need to be:

' Exposes the VBA DateAdd function for better use within worksheets
Public Function DateAdd_L(initial As Date, years As Integer, months As Integer, days As Integer) As Date
    Dim carry As Date
    carry = DateAdd("YYYY", years, initial)
    carry = DateAdd("M", months, carry)
    carry = DateAdd("D", days, carry)
    
    DateAdd_L = carry
End Function

' Gives a specific function to enable a period presented as a year decimal to be added to a date
Public Function DateAddYrDec(initial As Date, yeardecimal As Double) As Date
    DateAddM = DateAdd("M", yeardecimal * 12, initial)
End Function

' Returns a year decimal based on complete years and months between two dates
Public Function GetFullMthYrDecimal(ByVal StartDate As Date, ByVal EndDate As Date, _
                                Optional RoundTo As Integer = 4) As Double
    Dim res As Double
    
    res = Round((DateDiff("M", StartDate, EndDate)) / 12 _
                                    , RoundTo)
    If EndDate <= StartDate Then res = res * -1
    GetFullMthYrDecimal = res
End Function

' Returns a year decimal based on the actual time between two dates
Public Function GetAccYrDecimal(ByVal StartDate As Date, ByVal EndDate As Date, _
                                Optional RoundTo As Integer = 4) As Double
    Dim res As Double
    
    res = Round((DateDiff("M", StartDate, EndDate) + MonthDiffDec(StartDate, EndDate)) / 12 _
                                    , RoundTo)
    If EndDate <= StartDate Then res = res * -1
    GetAccYrDecimal = res
End Function


' Returns a number representing the percentage of month between two given dates, ignoring years
Public Function MonthDiffDec(varDateFrom As Variant, Optional varDateTo As Variant) As Variant
    Dim intMonths As Integer
    Dim IntDays As Integer
   
    If Not IsNull(varDateFrom) Then
        If IsMissing(varDateTo) Then varDateTo = VBA.Date
       
        intMonths = DateDiff("m", varDateFrom, varDateTo) - (GetAge(varDateFrom, varDateTo) * 12)
       
        If Day(varDateFrom) > Day(varDateTo) Then
            intMonths = intMonths - 1
            IntDays = varDateTo - DateSerial(Year(varDateTo), Month(varDateTo) - 1, Day(varDateFrom))
        Else
            IntDays = varDateTo - DateSerial(Year(varDateTo), Month(varDateTo), Day(varDateFrom))
        End If
       
        MonthDiffDec = intMonths + IntDays / Day(DateSerial(Year(varDateTo), Month(varDateTo) + 1, 0))
    End If

End Function

' Returns an integer of complete years for the passed dates
Public Function GetAge(varDoB As Variant, Optional varAgeAt As Variant) As Integer
    If IsMissing(varAgeAt) Then varAgeAt = VBA.Date
    
    GetAge = DateDiff("yyyy", varDoB, varAgeAt) - _
        IIf(Format(varAgeAt, "mmdd") < Format(varDoB, "mmdd"), 1, 0)

End Function























 

Created by JBaker. Last Modification: Monday November 25, 2019 10:57:46 GMT by JBaker.

Developer