Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Averageing accross tabs in excel. 1

Status
Not open for further replies.

quig699

Technical User
Nov 7, 2006
42
US
Hi,

I am trying to average data over several tabs in Excel 2010 without averging in zeros. I have tabs Monday, Tuesday, Wednesday, etc and need to average mutiple fileds on a totals page. I can average them like this

=AVERAGE(Monday!C4,Tuesday!C4,Wednesday!C4,Thursday!C4,Friday!C4)

But this does not exclude the zeros.

Any help is appreciated.

Thank you!!

Thanks,

Amy
 
I did try that but kept getting error messages. What would the prper syntax be?

Thanks,

Amy
 
What is YOUR formula?

Skip,
[sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 
the problem is with the ...IF functions, a cross sheet range does not seem to work.

Why do you have a separate sheet for each Day, Week, Month whatever?

You make your life much more difficult and much less satisfying and you multiply your sorrows and pain and increase your agonies and sufferings, when you needlessly and negligently chop up your data into separate locations!

faq68-5184

Skip,
[sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 
You can perform the equivalent of an AVERAGEIF over a 3D range using some VBA with a formula like:
=SUM(Monday:Friday!C4)/(CountIf3D(Monday:Friday!C4,">0") + CountIf3D(Monday:Friday!C4,"<0"))
If you have only positive numbers, blanks or zeros, you can eliminate the second CountIf3D from the above formula.

Unlike other 3D functions posted on the web, this one actually receives a 3D range and so will respond when the underlying data changes without being volatile.

You might think that using "<>0" as the criteria would shorten the formula to a single CountIf3D. But, just like in COUNTIF, that criteria counts blank cells as well as those containing text or non-zero numbers.

Code:
Function CountIf3D(rgToCheck, Criteria As Variant) As Variant
'Function works just like COUNTIF function, except can handle 3-D cell range references
'rgToCheck may be single sheet or multi-sheet references to one or more cells _
    Enter 3-D ranges just like in a SUM formula:   =CountIf3D('Sheet 1:Sheet 3'!A1:A7, ">0")
'Criteria may be a single value or an array of values
'Function returns the count of matching values if Criteria is a single value. It returns an array of counts if Criteria is an array. _
    =CountIf3D('Sheet 1:Sheet 3'!A1:A7, ">0")            returns a single value _
    =CountIf3D('Sheet 1:Sheet 3'!A1:A7, {">5", "<2"})    returns a two column array of values _
    =CountIf3D('Sheet 1:Sheet 3'!A1:A7, {">5"; "<2"})    returns a two row array of values (semicolon instead of comma in array constant) _
    =CountIf3D('Sheet 1:Sheet 3'!A1:A7, {">5", ">20"; "<2", "<1"}})   returns a two column by two row array of values _
    =CountIf3D('Sheet 1'!A1:A7, ">0")                            works just like a COUNTIF formula
'Note: there must be only one CountIf3D function in a formula--the wrong answer will be returned if there is more than one.
Dim cel As Range
Dim i As Long, j As Long, n As Long, nCols As Long, nRows As Long
Dim iFirstCheck As Integer, iLastCheck As Integer, k As Integer
Dim vCheck As Variant, vCriteria As Variant, vResults() As Variant
Dim wbCheck As Workbook
On Error Resume Next
Set cel = Application.Caller
If cel Is Nothing Then
    CountIf3D = "#NoRange"
    Exit Function
End If

vCheck = Parse3D(cel.Cells(1), "CountIf3D", 1)
Set wbCheck = Workbooks(vCheck(0))
iFirstCheck = wbCheck.Worksheets(vCheck(1)).Index
iLastCheck = wbCheck.Worksheets(vCheck(2)).Index

If VarType(Criteria) >= vbArray Then
    nCols = UBound(Criteria)
    nRows = UBound(Criteria, 2)
    If nCols = 0 Then nCols = 1
    If nRows = 0 Then nRows = 1
    ReDim vResults(1 To nRows, 1 To nCols)
Else
    ReDim vResults(1 To 1, 1 To 1)
    n = 1
    nRows = 1
    nCols = 1
End If
n = nRows * nCols
On Error GoTo 0

For i = 1 To nRows
    For j = 1 To nCols
        If n = 1 Then
            vCriteria = Criteria
        Else
            If nCols = 1 Then
                vCriteria = Criteria(i)
            ElseIf nRows = 1 Then
                vCriteria = Criteria(j)
            Else
                vCriteria = Criteria(i, j)
            End If
        End If
        If VarType(rgToCheck) = 10 Then
            For k = iFirstCheck To iLastCheck
                vResults(i, j) = vResults(i, j) + Application.CountIf(wbCheck.Worksheets(k).Range(vCheck(3)), vCriteria)
            Next
        Else
            vResults(i, j) = Application.CountIf(rgToCheck, vCriteria)
        End If
    Next
Next
CountIf3D = vResults
End Function

Private Function Parse3D(FormulaCell As Range, fnName As String, parmIndex As Integer) As Variant
'Parses a formula looking for a specified function. If found, returns a variant array containing four strings: _
    workbook name, first worksheet name, last worksheet name and range address. _
'Function tolerates commas in workbook or sheet names, array constants and range unions
'FormulaCell is a range variable pointing to the cell that contains the 3D formula
'fnName is the name of the 3D function, e.g. CountIf3D, SumIf3D, VLookup3D
'parmIndex is the index number of the parameter desired from the calling function
Dim i As Integer, i1 As Integer, i2 As Integer, i3 As Integer, j As Integer, k As Integer, n As Integer
Dim firstSheet As String, frmla As String, lastSheet As String, sPlaceHolder As String, sRange As String, _
    sSeparator As String, sSheets As String, sWorkbook As String, s1 As String, s2 As String
Dim nm As Name
Dim wb As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
sSeparator = ","        'The .Formula property uses a comma as list separator, no matter what the regional setting
sPlaceHolder = "?"      'This can be any character not found in workbook or worksheet names
frmla = FormulaCell.Formula
j = InStr(1, UCase(frmla), UCase(fnName) & "(")
If j > 0 Then
    sSheets = Mid(frmla, j + Len(fnName) + 1)
        
        'Eliminate any list separators that might be embedded in the formula
    For i = 0 To 4
        s1 = Array("'", """", "(", "{", "[")(i)
        s2 = Array("'", """", ")", "}", "]")(i)
        i1 = InStr(1, sSheets, s1)
        Do Until i1 = 0
            i2 = InStr(i1 + 1, sSheets, s2)
            If i <= 1 And Mid(sSheets, i2, 2) = (s1 & s1) Then i2 = InStr(i2 + 2, sSheets, s1)
            If i2 > 0 Then
                i3 = InStr(i1, sSheets, sSeparator)
                Select Case i3
                Case 0
                Case Is < i2
                    sSheets = Left(sSheets, i1) & Replace(Mid(sSheets, i1 + 1, i2 - i1 - 1), sSeparator, sPlaceHolder) & Mid(sSheets, i2)
                End Select
                i1 = InStr(i2 + 1, sSheets, s1)
            End If
        Loop
    Next
        
    sSheets = Split(sSheets, sSeparator)(parmIndex - 1)
    sSheets = Replace(sSheets, sPlaceHolder, sSeparator)    'Restore any list separators that had temporarily been replaced with placeholder
    If Right(sSheets, 1) = ")" Then sSheets = Left(sSheets, Len(sSheets) - 1)
        
        'Test whether parameter is a named range
    On Error Resume Next
    Set nm = FormulaCell.Parent.Names(sSheets)
    If nm Is Nothing Then Set nm = FormulaCell.Parent.Parent.Names(sSheets)
    On Error GoTo 0
    If Not nm Is Nothing Then sSheets = Mid(nm.RefersTo, 2)     'Delete the initial = sign
    
    sSheets = Replace(sSheets, "''", "'")   'Single quotes embedded within sheet names are doubled up to escape them
    k = InStrRev(sSheets, "!")
    If k = 0 Then
        sRange = sSheets
        firstSheet = FormulaCell.Worksheet.Name
        lastSheet = FormulaCell.Worksheet.Name
    Else
        sRange = Mid(sSheets, k + 1)
        sSheets = Left(sSheets, k - 1)
        k = InStr(1, sSheets, "]")
        If k > 0 Then
            sWorkbook = Split(sSheets, "]")(0)
            If Left(sWorkbook, 1) = "'" Then sWorkbook = Mid(sWorkbook, 2)
            If Left(sWorkbook, 1) = "[" Then sWorkbook = Mid(sWorkbook, 2)
            sSheets = Split(sSheets, "]")(1)
        End If
        If Left(sSheets, 1) = "'" Then sSheets = Mid(sSheets, 2)
        If Right(sSheets, 1) = "'" Then sSheets = Left(sSheets, Len(sSheets) - 1)
        k = InStr(1, sSheets, ":")
        If k = 0 Then
            firstSheet = sSheets
            lastSheet = sSheets
        Else
            firstSheet = Split(sSheets, ":")(0)
            lastSheet = Split(sSheets, ":")(1)
        End If
    End If
    If sWorkbook = "" Then sWorkbook = FormulaCell.Worksheet.Parent.Name
    Parse3D = Array(sWorkbook, firstSheet, lastSheet, sRange)
End If
End Function
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top