Subtracting Cells in the Status Bar

Sometimes I just want to quickly see the difference between two cells or groups of cells. Excel puts some great aggregates in the status bar.

and you can even customize them. Right click on the those aggregates.

But I wanted the difference. So I wrote some code to find it. I already had a class module with an Application object declared WithEvents, so I added this SheetSelectionChange event procedure.

Private Sub mxlApp_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
   
    If TypeName(Selection) = "Range" Then
        ShowDifferenceStatus Selection
    End If

End Sub

That event procedure calls this procedure in a standard module.

Public Sub ShowDifferenceStatus(rSel As Range)
       
    Dim wf As WorksheetFunction
    Dim vStatus As Variant
   
    On Error Resume Next

    Set wf = Application.WorksheetFunction
   
    If rSel.Areas.Count = 1 Then
        If rSel.Columns.Count = 2 Then
            vStatus = "Difference: " & Format(wf.Sum(rSel.Columns(1)) - wf.Sum(rSel.Columns(2)), "#,##0.00")
        ElseIf rSel.Rows.Count = 2 Then
            vStatus = "Difference: " & Format(wf.Sum(rSel.Rows(1)) - wf.Sum(rSel.Rows(2)), "#,##0.00")
        Else
            vStatus = False
        End If
    ElseIf rSel.Areas.Count = 2 Then
        If (rSel.Areas(1).Columns.Count = 1 And rSel.Areas(2).Columns.Count = 1) Or _
            (rSel.Areas(1).Rows.Count = 1 And rSel.Areas(2).Rows.Count = 1) Then
           
            vStatus = "Difference: " & Format(wf.Sum(rSel.Areas(1)) - wf.Sum(rSel.Areas(2)), "#,##0.00")
        End If
    Else
        vStatus = False
    End If
   
    Application.StatusBar = vStatus
   
End Sub

If the selection is contiguous (Areas.Count = 1), it determines if there are two columns or two rows. Then it uses the SUM worksheet function to sum up the first and subtract the sum of the second. Anything other that two columns tow rows resets the StatusBar by setting it to False. Subtracting one cell from the other is easy enough, but I wanted the ability to subtract one column from the other (or one row). Using SUM also avoids me having to check for text or other nonsense that SUM does automatically. Here’s one where I only have one Area selected and it contains two columns. It sums the numbers in column B and subtracts the sum of column C.

When the selection is not contiguous (Areas.Count = 2), then it determines if both areas have only one column or only one row. If either has more than one, it resets the status bar. But if they both have one (of either), it subtracts them. Here I’ve selected B2:B3, then held down the Control key while I selected C3:C4. That’s two areas, but each only has one column, so it assumes I want to subtract columns.

The next feature I want to add is to recognize filtered data. Often I’m working with a filtered Table and although two cells appear to be adjacent, selecting them without holding down Control really selects all those filtered cells in between. I guess I’ll need to loop through and determine what’s visible, build a range from only those cells, and sum that. For now, I’m just holding down control and using the mouse to select them. If you’re not familiar, the “mouse” is that blob of plastic several inches away from home row (aka the productivity killer). Excuse me while I get off my soap box and finish this post.

I tried to glean the NumberFormat of the cells selected and use that in the display. You can see from the code above that I punted and just used a comma and two decimals. But that stinks for really small numbers. Originally, I had something like

vStatus = "Difference: " & Format(wf.Sum(rSel.Columns(1)) - wf.Sum(rSel.Columns(2)), rSel.Cells(1).NumberFormat)

But look at the craziness when the cell as the Accounting format (_(* #,##0.00_);_(* (#,##0.00);_(* "-"??_);_(@_))

It works well for times though.

Apparently the syntax for cell formatting is slightly different than for the VBA.Format function. I haven’t worked out what the differences are, but maybe someday I will.

18 Comments

  1. M Simms says:

    re: “Apparently the syntax for cell formatting is slightly different than for the VBA.Format function”

    Great catch Dick. Once again, our “crack team” of Excel programmers are caught with coding two separate functions for cell formatting instead of one common function.

  2. snb says:

    I wouldn’t say slightly.
    No idea how to do this in cell formatting:

    Sub M_snb()
        MsgBox Format("abc", ">")
    End Sub
  3. Bob Phillips says:

    You can always do Application.Text in your VBA.

  4. snb says:

    But the other way around you would need a UDF

  5. Bob Phillips says:

    What, for stuff such as you show? UPPER seems a tad simpler to me.

  6. Alex says:

    I’ve just finished with a similar tool.
    Save the following project as .xla

    Thisworkbook:

    Private WithEvents oXLApp As Excel.Application

    Private Sub Workbook_Open()
        Set oXLApp = Excel.Application
    End Sub

    Private Sub oXLApp_SheetSelectionChange(ByVal Sh As Object, ByVal Target As range)

    Dim limit As Long
    limit = 300000 ' selection limit

    Dim frmt As String
    frmt = "#,##0;(#,##0);""-""" ' formating at status bar

    ' first condition - one selection area


    If Selection.Areas.Count = 1 Then

    On Error Resume Next
    If Selection.Cells.Count > 1 And Selection.Cells.Count < limit Then
       On Error Resume Next
            Application.StatusBar = _
                "       D:    " & Format(WorksheetFunction.Max(Selection) - WorksheetFunction.Min(Selection), frmt) & _
                "       U:    " & Format(Unique(Selection), frmt) & _
                "       2X:    " & Format(WorksheetFunction.Sum(Selection) * 2, frmt) & _
                "       X2:    " & Format(WorksheetFunction.Sum(Selection) / 2, frmt) & _
                "       NC:    " & Format(WorksheetFunction.CountIf(Selection, "<0"), frmt) & _
                "       NS:    " & Format(WorksheetFunction.SumIf(Selection, "<0"), frmt)
    Else


    If Selection.Cells.Count = 1 Or Selection.Cells.Count >= limit Then
       On Error Resume Next
            Application.StatusBar = False
        End If ' No condition
    End If ' Cells > 2 and < limit
    End If ' Areas = 1 - end of first condition


    ' second condition - more than one selection areas



    If Selection.Areas.Count > 1 Then

    Dim r1 As range
    Dim r2 As range
    Set r1 = Selection.Areas(1)
    'WorksheetFunction.Sum (r1)
    On Error Resume Next
    Set r2 = Selection.Areas(2)
    'Set multipleRange = Union(r1, r2)

    On Error Resume Next
    If Selection.Cells.Count > 1 And Selection.Cells.Count < limit Then
       On Error Resume Next
            Application.StatusBar = _
                "       D:    " & Format(DIFF(r1, r2), frmt) & _
                "       U:    " & Format(Unique(r1), frmt) & _
                "       2X:    " & Format(WorksheetFunction.Sum(r1) * 2, frmt) & _
                "       X2:    " & Format(WorksheetFunction.Sum(r1) / 2, frmt) & _
                "       NC:    " & Format(WorksheetFunction.CountIf(r1, "<0"), frmt) & _
                "       NS:    " & Format(WorksheetFunction.SumIf(r1, "<0"), frmt)
    Else


    If Selection.Cells.Count = 1 Or Selection.Cells.Count >= limit Then
       On Error Resume Next
            Application.StatusBar = False
        End If ' no condition
    End If ' Cells > 1
    End If ' Areas > 1 - end of second condition

    End Sub

    Module 1:

    Public Function DIFF(rng1 As range, rng2 As range)
       DIFF = WorksheetFunction.Sum(rng1) - WorksheetFunction.Sum(rng2)
    End Function

    Module 2:

    Public Function Unique(ByRef rngToCheck As range) As Variant
     
        Dim colDistinct As Collection
        Dim varValues As Variant, varValue As Variant
        Dim lngCount As Long, lngRow As Long, lngCol As Long
     
        On Error GoTo ErrorHandler
     
        varValues = rngToCheck.Value
     
        'if rngToCheck is more than 1 cell then
        'varValues will be a 2 dimensional array
        If IsArray(varValues) Then
     
            Set colDistinct = New Collection
     
            For lngRow = LBound(varValues, 1) To UBound(varValues, 1)
                For lngCol = LBound(varValues, 2) To UBound(varValues, 2)
     
                    varValue = varValues(lngRow, lngCol)
     
                    'ignore blank cells and throw error
                    'if cell contains an error value
                    If LenB(varValue) > 0 Then
     
                        'if the item already exists then an error will
                        'be thrown which we want to ignore
                        On Error Resume Next
                        colDistinct.Add vbNullString, CStr(varValue)
                        On Error GoTo ErrorHandler
     
                    End If
     
                Next lngCol
            Next lngRow
     
            lngCount = colDistinct.Count
        Else
            If LenB(varValues) > 0 Then
                lngCount = 1
            End If
     
        End If
     
        Unique = lngCount
     
        Exit Function
     
    ErrorHandler:
        Unique = CVErr(xlErrValue)
     
    End Function
  7. snb says:

    we were discussing:

    re: “Apparently the syntax for cell formatting is slightly different than for the VBA.Format function”

  8. Jeff Weir says:

    Hey, that’s really cool! I’m off to impress my accountant friends. (Yes, my only friends are accountants. I work for the tax department. I think there’s a correlation there.)

  9. Mike says:

    Very useful thanks,
    My function is similar with a couple of differences;
    When one cell is selected the report is 1/n, Sqrt(n), n^2, kg to lbs, mm to inches, ft to m.

    When the range involves 2 columns of numbers an XY plot is drawn using Shapes.Addline.
    Right-clicking the mouse deletes the plot
    It’s a very fast and efficient way of reviewing data.

    Happy to share but the VBA is inelegant and would benefit from a professional review first.

  10. > snb says:
    > we were discussing:
    > re: “Apparently the syntax for cell formatting is slightly different than for the VBA.Format function”

    To that end, let’s “spice up” your example a little bit…

    MsgBox Format(“abc”, “@x^2 – @x + @ = 0>”)

  11. snb says:

    @Rick

    You did,

    not to mention:

    MsgBox Format("abc", "@x^2 – @x + @ + @ = 0>!")
  12. @snb,

    Interesting… all this time working with VB/VBA and I always thought the exclamation mark had to be at the beginning of the pattern string to force filling from the left, but you used it at the end and it still worked. That got me to experimenting… it does not matter where in the pattern string the exclamation mark is, it will still reverse the fill direction. For example, how3 about in the middle…

    MsgBox Format(“abc”, “@x^2 – @x +! @ + @ = 0>”)

  13. Alex says:

    Does someone know how to make all these things work correctly on filtered ranges?
    Excel’s Sum, Average, Count… functions in the status bar consider only visible cells.
    Also to mention is that native status bar functions work very fast, whereas the VBA from above can’t handle many rows.

  14. snb says:

    @Rick

    I don’t think it matters where you put ‘them’ operators: !
    Before, after or between the other characters of the format string.

  15. […] You can select numbers on a worksheet, and see a Sum, Count, or other summaries in the Status bar. There’s no Subtraction option, so Dick Kusleika created one of his own. […]

  16. Jonathan says:

    Would subtotal work using the 109 argument!

    =subtotal(“109″,rng1)

  17. Matth78 says:

    For anyone interested I check for “_($” in formatnumber string to detect accounting format. (Maybe I could check only $ ?)
    If accounting format is found then I use formatnumberLOCAL in conjonction with worksheetfunction.text (instead of format and formatnumber)

Posting code or formulas in your comment? Use <code> tags!

  • <code lang="vb">Block of code goes here</code>
  • <code lang="vb" inline="true">Inline code goes here</code>
  • <code>Formula goes here</code>

Leave a Reply

Here's how to update your reports of company and nearly any web data: