VBA Coding for Averageifs that needs to dynamically adjust over 8 quarters

[kewiopex]

Dear Experts
I am greatly in need for vba coding for myself and others to easily adjust the ranges of the Averageifs formula for each new quarter of information that is added.
The Averageifsformla covers 8 quarters, so as a new quarter of data is added, the formula needs to adjust the ranges by moving the starting range position and the ending range by 1 quarter. Each quarter has 6 columns of data.
So as an example from the attached excel sheet, =AVERAGEIFS(C4:BA4,$C$3:$BA$3,"<>NB") that covers 8 quarters of data in the first row, if a new quarter was added the formula would now be =AVERAGEIFS(I4:BG4,$C$3:$BG$3,"<>NB")
I have attached a copy of the excel sheet. It has been abbreviated.
Any help to get me started would be wonderful.
Although I am requesting VBA code any other suggestions are welcomed indeed.

[Paul_Hossler]

Some quarters have different numbers of columns

Capture.JPG

Include them in the average?

So basically you just want the latest 8 chunks of merged cells from row 2?


Also, do you always want to use the same criteria?

(I4:BG4,$C$3:$BG$3,"<>NB")

[Paul_Hossler]

Based on the way the data is laid out, something like this as a user function

Look at B7 on sheet Test

Option Explicit

Function Average8Quarters() As Variant
    Dim iCallerRow As Long, iFirstColumn As Long, iLastColumn As Long, i As Long
    Dim rData As Range, rCriteria As Range
    
        
    Application.Volatile
    
    On Error GoTo NiceExit
    
    iCallerRow = Application.Caller.Row
    
    
    With ActiveSheet
        iFirstColumn = .Cells(2, .Columns.Count).End(xlToLeft).Column

        With .Cells(2, iFirstColumn)
            iLastColumn = .Column + .MergeArea.Columns.Count - 1
        End With
        
        For i = 1 To 7
            iFirstColumn = .Cells(2, iFirstColumn).End(xlToLeft).Column
        Next I
        
        Set rData = .Cells(iCallerRow, iFirstColumn).Resize(1, iLastColumn - iFirstColumn + 1)
        Set rCriteria = .Cells(3, iFirstColumn).Resize(1, iLastColumn - iFirstColumn + 1)
    End With

    Average8Quarters = Application.WorksheetFunction.AverageIfs(rData, rCriteria, "<>NB")

    Exit Function

NiceExit:
    Average8Quarters = CVErr(xlErrNum)
End Function

[kewiopex]

Hi Paul
Terrific work! Spot on! I now understand the code a little better but will dig into the cell references some more. I am learning the language somewhat and use a number of references and internet to help. This forum is the best.

[kewiopex]

Paul
As an aside question, I thought that to have the averageifs apply to other rows, I would simply set up a macro to copy paste but as requested, we set it up for row 2. Is there a need to adapt the code for additional rows ?
Thank you for your great support.

[Paul_Hossler]

I used Application.Caller which returns the cell as a Range object where the function is on the worksheet

The Quarters are always in row 2, and you want the latest 8 merged cells

The <>NB is always in row 3, and I used the same columns for those and the row-specific data to average

The .Caller row is the data to average



I added some comments to the macro

Capture.JPG

Option Explicit

Function Average8Quarters() As Variant
    Dim iCallerRow As Long, iFirstColumn As Long, iLastColumn As Long, i As Long
    Dim rData As Range, rCriteria As Range
    
    'always update function even if the explicit inputs did not change
    Application.Volatile
    
    'if there's some error just return a standard Excel error and exit
    On Error GoTo NiceExit
    
    'get the row number one the worksheet where the function is called (e.g. B4 for the first, and B5 for the second
    iCallerRow = Application.Caller.Row
    
    'little more elegant
    ' .Caller returns the cell the function is in, and .Parent = the cell's parent, i.e. the worksheet
    With Application.Caller.Parent
        
        'get the first column in row 2 (i.e. AS2) of the merged cell column number (it's = 45)
        iFirstColumn = .Cells(2, .Columns.Count).End(xlToLeft).Column
        
        'get the 'real' last column of the merged cell
        'start with (2,45)
        With .Cells(2, iFirstColumn)
            'add 45 + 9 - 1 = 53 (2016 3rd Qtr has 9 columns
            iLastColumn = .Column + .MergeArea.Columns.Count - 1
        End With
        
        'back up 7 more quarters and get that merged cell's starting column number
        For i = 1 To 7
            iFirstColumn = .Cells(2, iFirstColumn).End(xlToLeft).Column
        Next I
        
        'now we know that for the row the function is in, the data starts in
        '    (2, 3) and goes for 1 row and (53-3+1 = 51 more columns
        Set rData = .Cells(iCallerRow, iFirstColumn).Resize(1, iLastColumn - iFirstColumn + 1)
        
        'now we know that the criteria always is in row 3,and is the same number of columns as the data
        '     calculated above
        Set rCriteria = .Cells(3, iFirstColumn).Resize(1, iLastColumn - iFirstColumn + 1)
    End With

    'call the worksheet function with the 2 ranges, and the fixed string critera
    Average8Quarters = Application.WorksheetFunction.AverageIfs(rData, rCriteria, "<>NB")

    'get out here so we don't execute the error handler code that follows
    Exit Function

NiceExit:
    Average8Quarters = CVErr(xlErrNum)
End Function

[kewiopex]

Wow, Paul! I did a check on google for some of the terms such as = Application.Caller.Row. Some really cool coding stuff that I had not seen before. And very elegant some may say. I cannot thank you enough.