CODEWITHSUNDEEP
vbaexcel
Newskooler
Newskooler

Reputation: 4255

Adding a Trailing Twelve Months array feature to VBA code

I have an existing code which is a function that yields an array: Example input: =cellrange(B5,"ytd") [where from B5 and below (or above) there are dates] Example output: $B$129:$B$280 which is the full date range for this year in column B

I am trying to add a new case called ttm (trailing twelve months), however I am struggling to find a way to incorporate it.

The ttm case should show yield a trailing 12 months range from the latest available date

Option Explicit

Public Function cellrange(rDates As Range, vFilter As Variant, Optional colOffsetA As Variant, Optional colOffsetB As Variant) As String
'DESCRIPTION:
    'This function takes any cell value in a row and a input: YTD, ALL, or any year (i.e. 2014, 2015) and it finds the range in which the date is situated

    Dim i As Long, ndx1 As Long, ndx2 As Long, r As Range, vA As Variant, bErr As Boolean, bAll As Boolean
    bErr = True
    If IsDate(rDates) Then
        With rDates.EntireColumn
            i = rDates.Parent.Evaluate("count(" & .Address & ")")
            Set r = .Cells(1 - i + rDates.Parent.Evaluate("index(" & .Address & ",match(9.9E+307," & .Address & "))").row).Resize(i, 1)
        End With
        vA = r.Value
        If IsMissing(colOffsetA) And IsMissing(colOffsetB) Then
            colOffsetA = 0: colOffsetB = 0
        End If
        If IsMissing(colOffsetB) = True Then colOffsetB = colOffsetA
        Select Case LCase(vFilter)
            Case "all"
                bErr = 0: bAll = 1
                Set r = r.Range(r.Parent.Cells(1, 1 + colOffsetA), r.Parent.Cells(r.Count, 1 + colOffsetB))
            Case "ytd"
                For i = 1 To UBound(vA)
                    If ndx1 = 0 And Year(vA(i, 1)) = Year(Date) Then ndx1 = i
                    If vA(i, 1) <= Date Then ndx2 = i
                Next
            Case Else 'year
                vFilter = Val(vFilter)
                If vFilter Then
                    For i = 1 To UBound(vA)
                        If ndx1 = 0 And Year(vA(i, 1)) = vFilter Then ndx1 = i
                        If ndx1 And Year(vA(i, 1)) = vFilter Then ndx2 = i
                    Next
                End If
        End Select
        If Not bAll Then If ndx1 > 0 And ndx2 > 0 Then Set r = r.Range(r.Parent.Cells(ndx1, 1 + colOffsetA), r.Parent.Cells(ndx2, 1 + colOffsetB)): bErr = False
        If Not bErr Then cellrange = r.Address Else cellrange = CVErr(xlErrValue)
    Else
        cellrange = CVErr(xlErrValue) 'check if this is the correct error handling
    End If
End Function

Upvotes: 0

Views: 173

Answers (1)

Excel Hero
Excel Hero

Reputation: 14764

This includes the "ttm" case:

Public Function cellrange(rDates As Range, vFilter As Variant, Optional colOffsetA As Variant, Optional colOffsetB As Variant) As String
    Dim i As Long, ndx1 As Long, ndx2 As Long, r As Range, vA As Variant, bErr As Boolean, bAll As Boolean
    bErr = True
    If IsDate(rDates) Then
        With rDates.EntireColumn
            i = rDates.Parent.Evaluate("count(" & .Address & ")")
            Set r = .Cells(1 - i + rDates.Parent.Evaluate("index(" & .Address & ",match(9.9E+307," & .Address & "))").row).Resize(i, 1)
        End With
        vA = r.Value
        If IsMissing(colOffsetA) And IsMissing(colOffsetB) Then
            colOffsetA = 0: colOffsetB = 0
        End If
        If IsMissing(colOffsetB) = True Then colOffsetB = colOffsetA
        Select Case LCase(vFilter)
            Case "all"
                bErr = 0: bAll = 1
                Set r = r.Range(r.Parent.Cells(1, 1 + colOffsetA), r.Parent.Cells(r.Count, 1 + colOffsetB))
            Case "ytd"
                For i = 1 To UBound(vA)
                    If ndx1 = 0 And Year(vA(i, 1)) = Year(Date) Then ndx1 = i
                    If vA(i, 1) <= Date Then ndx2 = i
                Next
            Case "ttm"
                For i = 1 To UBound(vA)
                    If ndx1 = 0 And Date - vA(i, 1) <= (Date - DateSerial(Year(Date) - 1, Month(Date), Day(Date) - 1)) Then ndx1 = i
                    If vA(i, 1) <= Date Then ndx2 = i
                Next
            Case Else 'year
                vFilter = Val(vFilter)
                If vFilter Then
                    For i = 1 To UBound(vA)
                        If ndx1 = 0 And Year(vA(i, 1)) = vFilter Then ndx1 = i
                        If ndx1 And Year(vA(i, 1)) = vFilter Then ndx2 = i
                    Next
                End If
        End Select
        If Not bAll Then If ndx1 > 0 And ndx2 > 0 Then Set r = r.Range(r.Parent.Cells(ndx1, 1 + colOffsetA), r.Parent.Cells(ndx2, 1 + colOffsetB)): bErr = False
        If Not bErr Then cellrange = r.Address Else cellrange = CVErr(xlErrValue)
    Else
        cellrange = CVErr(xlErrValue)
    End If
End Function

Upvotes: 1

Related Questions