Archive for the ‘Excel Experts E-Letter’ Category.

Power Formulas for Unique Data

Created by David Hager, Bob Umlas and Laurent Longre

The problem - to create an array containing only the unique items from an expanding column list. In other words, if items are typed down column A, what is the formula that will return the unique items? The following example further illustrates the problem.

In this case, the array should be {”a”;”b”;1;3}. Then, if additional values
are added:

the array should be {”a”;”b”;1;3;”c”;”d”}. The answer to this problem has eluded me for years, but with recent input from Bob and Laurent, I have successfully constructed a solution to this problem. The formula is somewhat long, so it is necessary to define parts of the formula to simplify the final form.

Create a defined name with a Name of TheList and a Refers to of:

=OFFSET(Sheet1!$A$1,,,COUNTA(Sheet1!$A:$A),)

This formula creates the expanding range for the items as they are entered
into column A.

Define sArray as:

=SMALL(IF(MATCH(TheList,TheList,0)=ROW(TheList),ROW(TheList),""),
ROW(INDIRECT(”1:”&SUM(N(MATCH(TheList,TheList,0)=ROW(TheList))))))-1

This formula contains several important elements that require explanation. The formula

IF(MATCH(TheList,TheList,0)=ROW(TheList),ROW(TheList),"")

returns an array of positions for the unique items that is the same size as the TheList array, where the duplicates items are now represented by empty strings. The formula

ROW(INDIRECT("1:"&SUM(N(MATCH(TheList,TheList,0)=ROW(TheList)))))

returns an array of numbers from 1 to n, where n is the number of unique items in the list, as calculated by the formula

SUM(N(MATCH(TheList,TheList,0)=ROW(TheList))).

What is desired is an array that contains the unique positions with no empty strings. This is accomplished by the use of the SMALL function which, along with the LARGE function, is unique among Excel functions in its ability to create different sized arrays than the array used in the 1st argument if the 2nd argument is also an array. The -1 is used to adjust the item positions for use in the formula shown below.

Define TheUniqueArray as:

=IF(T(OFFSET(TheList,sArray,,1))="",N(OFFSET(TheList,sArray,,1)),T(OFFSET(TheList,sArray,,1)))

The formula

OFFSET(TheList,sArray,,1)

is an array of single element arrays, as explained in detail in the 1st issue of EEE. It can be converted into a normal array by using the N or T functions. Both N and T are used here since TheList can contain either text or numeric items.

WARNING: This formula can take a while to calculate if TheList is long. One thousand items took a couple of seconds on my Latitude D810.

Formulas for Unique Data

Created by David Hager

This array formula returns the number of unique items in a worksheet range.

=SUM(1/COUNTIF(Rng,Rng))

However, if Rng contains blank cells, this formula returns an error. In this case, use this modified version of the formula.

=SUM(COUNTIF(Rng,Rng)/IF(NOT(COUNTIF(Rng,Rng)),1,COUNTIF(Rng,Rng))^2)

This array formula returns the Nth largest unique value in a column range.

=LARGE(IF(MATCH(Rng,Rng,0)=ROW(Rng)-MIN(ROW(Rng))+1,Rng,""),N)

To apply data validation to a column which allows only unique items to be entered, highlight that column and select Data, Validation from the menu. Choose the custom option and enter the following formula (for column A):

=COUNTIF($A$1:A1,A1)=1

Created by Laurent Longre

This formula counts the number of unique items a column range, only if the cells in the lookup range contain the specified string.

=SUM(N(FREQUENCY(IF(lookupRange="specifStr",MATCH(colRange,colRange,0)),MATCH(colRange,colRange,0))>0))

Editor’s Note:
rng = A1:A7
colRange = A1:A7
lookupRange = B1:B7

Don’t forget to enter those array formula with Control+Shift+Enter, not just Enter.

3D User Defined Functions

By Myrna Larson and David Hager

Presented below are 3 UDF's (SumProduct3D, SumIf3D, CountIf3D) that
provide a useful method of returning a variety of information from 3D
ranges. Each of these functions use a 3D range argument (written as per
the usual Excel protocol) as a string. This string is processed by the
Parse3DRange function, which returns sheet positions and the range argument
in variables that are used by these functions.

Function SumProduct3D(Range3D As String, Range_B As Range) _
    As Variant
 
    Dim sRangeA As String
    Dim sRangeB As String
    Dim Sheet1 As Integer
    Dim Sheet2 As Integer
    Dim Sum As Double
    Dim n As Integer
 
    Application.Volatile
 
    If Parse3DRange(Application.Caller.Parent.Parent.Name, _
      Range3D, Sheet1, Sheet2, sRangeA) = False Then
      SumProduct3D = CVErr(xlErrRef)
      Exit Function
    End If
    sRangeB = Range_B.Address
 
    Sum = 0
    For n = Sheet1 To Sheet2
      With Worksheets(n)
        Sum = Sum + Application.WorksheetFunction.SumProduct( _
    .Range(sRangeA), .Range(sRangeB))
      End With
    Next
    SumProduct3D = Sum
  End Function
 
Function SumIf3D(Range3D As String, Criteria As String, _
    Optional Sum_Range As Variant) As Variant
 
    Dim sTestRange As String
    Dim sSumRange As String
    Dim Sheet1 As Integer
    Dim Sheet2 As Integer
    Dim n As Integer
    Dim Sum As Double
 
    Application.Volatile
 
    If Parse3DRange(Application.Caller.Parent.Parent.Name, _
      Range3D, Sheet1, Sheet2, sTestRange) = False Then
      SumIf3D = CVErr(xlErrRef)
    End If
 
    If IsMissing(Sum_Range) Then
      sSumRange = sTestRange
    Else
      sSumRange = Sum_Range.Address
    End If
 
    Sum = 0
    For n = Sheet1 To Sheet2
      With Worksheets(n)
        Sum = Sum + Application.WorksheetFunction.SumIf(.Range _
    (sTestRange), Criteria, .Range(sSumRange))
      End With
    Next n
    SumIf3D = Sum
  End Function
 
Function CountIf3D(Range3D As String, Criteria As String) _
    As Variant
 
    Dim Sheet1 As Integer
    Dim Sheet2 As Integer
    Dim sTestRange As String
    Dim n As Integer
    Dim Count As Long
 
    Application.Volatile
 
    If Parse3DRange(Application.Caller.Parent.Parent.Name, _
      Range3D, Sheet1, Sheet2, sTestRange) = False Then
      CountIf3D = CVErr(xlErrRef)
      Exit Function
    End If
 
    Count = 0
    For n = Sheet1 To Sheet2
        With Worksheets(n)
          Count = Count + Application.WorksheetFunction.CountIf( _
      .Range(sTestRange), Criteria)
        End With
    Next n
    CountIf3D = Count
  End Function
 
Function Parse3DRange(sBook As String, SheetsAndRange _
    As String, FirstSheet As Integer, LastSheet As Integer, _
    sRange As String) As Boolean
 
    Dim sTemp As String
    Dim i As Integer
    Dim Sheet1 As String
    Dim Sheet2 As String
 
    Parse3DRange = False
    On Error GoTo Parse3DRangeError
 
    sTemp = SheetsAndRange
    i = InStr(sTemp, "!")
    If i = 0 Then Exit Function
 
    'next line will generate an error if range is invalid
    'if it's OK, it will be converted to absolute form
    sRange = Range(Mid$(sTemp, i + 1)).Address
 
    sTemp = Left$(sTemp, i - 1)
    i = InStr(sTemp, ":")
    Sheet2 = Trim(Mid$(sTemp, i + 1))
    If i> 0 Then
      Sheet1 = Trim(Left$(sTemp, i - 1))
    Else
      Sheet1 = Sheet2
    End If
 
    'next lines will generate errors if sheet names are invalid
    With Workbooks(sBook)
    FirstSheet = .Worksheets(Sheet1).Index
    LastSheet = .Worksheets(Sheet2).Index
 
    'swap if out of order
    If FirstSheet> LastSheet Then
      i = FirstSheet
      FirstSheet = LastSheet
      LastSheet = i
    End If
 
    i = .Worksheets.Count
    If FirstSheet>= 1 And LastSheet <= i Then
      Parse3DRange = True
    End If
    End With
Parse3DRangeError:
    On Error GoTo 0
    Exit Function
 
End Function  'Parse3DRange

Editor's Note: I didn't like that the second argument was a range that had to mirror the 3D-ness of the first string-range. I change the parsing function to return an array of ranges so that you could put any two equally sized ranges in as arguments and one, both, or neither have to be 3D. The downside is that both arguments have to be strings.

Function SumProduct3D2(sRng1 As String, sRng2 As String) _
    As Variant
 
    Dim vaRng1 As Variant, vaRng2 As Variant
    Dim rTemp As Range
    Dim i As Long
    Dim Sum As Double
    Dim rCell As Range
   
    Application.Volatile
   
    vaRng1 = Parse3DRange2(Application.Caller.Parent.Parent, sRng1)
    vaRng2 = Parse3DRange2(Application.Caller.Parent.Parent, sRng2)
   
    For i = LBound(vaRng1) To UBound(vaRng1)
        Sum = Sum + (vaRng1(i).Value * vaRng2(i).Value)
    Next i
   
    SumProduct3D2 = Sum
   
  End Function
 
Function SumIf3D2(Range3D As String, Criteria As String, _
    Optional Sum_Range As String) As Variant
 
    Dim Sum As Double
    Dim vaRng1 As Variant, vaRng2 As Variant
    Dim i As Long
   
    Application.Volatile
   
    If Len(Sum_Range) = 0 Then
      Sum_Range = Range3D
    End If
 
    vaRng1 = Parse3DRange2(Application.Caller.Parent.Parent, Range3D)
    vaRng2 = Parse3DRange2(Application.Caller.Parent.Parent, Sum_Range)
   
    Sum = 0
    For i = LBound(vaRng1) To UBound(vaRng1)
        Sum = Sum + Application.WorksheetFunction.SumIf(vaRng1(i), Criteria, vaRng2(i))
    Next i
   
    SumIf3D2 = Sum
   
End Function
 
Function CountIf3D2(Range3D As String, Criteria As String) _
    As Variant
 
    Dim i As Long
    Dim Count As Long
    Dim vaRng1 As Variant
   
    Application.Volatile
 
    vaRng1 = Parse3DRange2(Application.Caller.Parent.Parent, Range3D)
 
    Count = 0
    For i = LBound(vaRng1) To UBound(vaRng1)
        Count = Count + Application.WorksheetFunction.CountIf(vaRng1(i), Criteria)
    Next i
   
    CountIf3D2 = Count
   
End Function
 
Function Parse3DRange2(wb As Workbook, _
                        SheetsAndRange As String) As Variant
 
    Dim sTemp As String
    Dim i As Long, j As Long
    Dim Sheet1 As String, Sheet2 As String
    Dim aRange() As Range
    Dim sRange As String
    Dim lFirstSht As Long, lLastSht As Long
    Dim rCell As Range
    Dim rTemp As Range
   
    On Error GoTo Parse3DRangeError
 
    sTemp = SheetsAndRange
       
    'if it's 3d, rtemp will be nothing
    On Error Resume Next
        Set rTemp = Range(sTemp)
    On Error GoTo Parse3DRangeError
   
    'if it's 3d, parse it
    If rTemp Is Nothing Then
       i = InStr(sTemp, "!")
       If i = 0 Then Err.Raise 9999
   
       'next line will generate an error if range is invalid
       'if it's OK, it will be converted to absolute form
       sRange = Range(Mid$(sTemp, i + 1)).Address
   
       sTemp = Left$(sTemp, i - 1)
       i = InStr(sTemp, ":")
       Sheet2 = Trim(Mid$(sTemp, i + 1))
       If i> 0 Then
           Sheet1 = Trim(Left$(sTemp, i - 1))
       Else
           Sheet1 = Sheet2
       End If
   
       'next lines will generate errors if sheet names are invalid
       With wb
           lFirstSht = .Worksheets(Sheet1).Index
           lLastSht = .Worksheets(Sheet2).Index
       
           'swap if out of order
           If lFirstSht> lLastSht Then
               i = lFirstSht
               lFirstSht = lLastSht
               lLastSht = i
           End If
             
           'load each cell into an array
           j = 0
           For i = lFirstSht To lLastSht
               For Each rCell In .Sheets(i).Range(sRange)
                   ReDim Preserve aRange(0 To j)
                   Set aRange(j) = rCell
                   j = j + 1
               Next rCell
           Next i
       End With
       
       Parse3DRange2 = aRange
    Else
        'range isn't 3d, so just load each cell into array
        For Each rCell In rTemp.Cells
            ReDim Preserve aRange(0 To j)
            Set aRange(j) = rCell
            j = j + 1
        Next rCell
       
        Parse3DRange2 = aRange
    End If
   
Parse3DRangeError:
    On Error GoTo 0
    Exit Function
 
End Function  'Parse3DRange

3D Array Formulas

Created by Laurent Longre

The problem - to make a 3D worksheet array formula. What this means is to
create an array representing a z-range (a range across worksheets) that
evaluates in the formula bar as an array. The 3D range used in Excel, i.e.

Sheet1:Sheet4!A2:B5

does not behave that way. I suspect that nearly everyone on the EEE list
has tried to do this and found that it was not possible. However, Laurent
found that it was possible, given some advanced formula tricks. The INDIRECT
function can return a 3D reference if it is operated on by the N function.
An illustration of this type of formula is shown below.

3D Diagonal Formula -

=SUM(N(INDIRECT("Sheet"&{1,2,3}&"!"&ADDRESS({1,2,3},{1,2,3}))))

returns the sum of Sheet1!A1, Sheet2!B2 and Sheet3!C3. How does it work?

"Sheet"&{1,2,3}&"!"&ADDRESS({1,2,3},{1,2,3}) evaluates to the array of
strings.

{"Sheet1!$A$1","Sheet2!$B$2","Sheet3!$C$3"}

When the INDIRECT function operates on this array, the expected array of
values appear (by highlighting in the formula bar and pressing F9), but
for some reason this array cannot be used by Excel functions. The use of
the N function creates an array that can be used, so that the SUM function
returns the desired result.

3D Running Formulas

POWER FORMULA TECHNIQUES

Created by David Hager

The problem - to make a 3D formula that adjusts in a z-relative manner
when it is filled across worksheets. Two separate solutions to this problem
that use a similar methodology are shown below.

Making a 3D Running Total -

This example uses information entered in column A, with the 3D Running Total
formula in column B.

Define shtPos as:

This formula returns the sheet position of the active sheet as an integer.

=GET.DOCUMENT(87)

Define wsNames as:

This formula returns an array of sheet names in the active workbook.

=RIGHT(GET.WORKBOOK(1),LEN(GET.WORKBOOK(1))-FIND("]",GET.WORKBOOK(1)))

Define shtName as:

This formula returns the active sheet name.

=INDEX(wsNames,shtPos)

Note: The string returned from GET.DOCUMENT(76) could have been modified
to obtain the active sheet name, but the method shown above was used since
the modified array of sheet names was available (and needed for another
3D example).

Define RunningTotal as:

=EVALUATE("SUM(Sheet1:"&shtName&"!A"&ROW()&")")+NOW()*0

This formula returns the sum for the cell in column A for each worksheet
from Sheet1 to the worksheet where the formula resides. For example, if
the active sheet was Sheet4 and this formula was in B2, this formula
(entered as =RunningTotal) would be the equivalent of the Excel formula
=SUM(Sheet1:Sheet4!A2). Since this formula incorporates xlm macro functions,
it must be forced to recalculate. This is done by using the term NOW()*0,
since NOW() is a volatile function.

Making a 3D Moving Average -

Define shtNamem2 as:

=INDEX(wsNames,shtPos-2)

This formula returns the sheet name of the worksheet 2 tabs to the left of
the active sheet.

Define MovingAverage as:

=EVALUATE("AVERAGE("&shtNamem2&":"&shtName&"!A"&ROW()&")")+NOW()*0

This formula returns the average of the values in the sheet 2 tabs to the
left of the active sheet to the active sheet. For example, if the active
sheet was Sheet4 and this formula (entered as =MovingAverage) was in B2,
this formula would be the equivalent of the Excel formula =AVERAGE(Sheet2
:Sheet4!A2).

Editor's Note: Here's the first method in action:

four sheets and a formula to sum them

Same setup, but for the second method:

four sheets and a formula to sum them

Conditional Formatting Across Sheets

Created by David Hager

To make a conditional format based on the value in the previous
worksheet, create the following defined name formulas.

GlobRef as:

=INDIRECT("rc",FALSE)

which gives the value from the cell it is used in.

PrevShtValue as:

=INDIRECT(INDEX(GET.WORKBOOK(1),GET.DOCUMENT(87)-1)&"!"&ADDRESS(ROW(),
COLUMN()))

which gives the value from the cell of the same address in the previous
sheet.

Then, combine these in yet another defined name formula.

GTPSV (this cell value is greater than previous sheet value) as:

=GlobRef>PrevShtValue

which is used as the conditional formatting formula (in Excel 97 and later
versions).

Editor's Note: The value on the sheet to the left, in my test, is zero (i.e., less than two).

conditional formatting dialog with effected range behind it