Camera Tool – Now With 33% More Picture

I’ve posted before about Excel’s handy camera tool. I don’t use it much, but I have one monster report that relies on it extensively. It contains code that uses the Shape object’s ScaleWidth method. I went to run the report yesterday and all my camera-generated-pictures got bigger. For reasons lost in the murk of time, I was setting the pictures’ ScaleWidth’s to 1, which made them adjust nicely when the range they point at changes size.

Anyways, all of a sudden the pictures got bigger when the code ran. So I came home and reproduced it on a different computer, without code. Sure enough, the same thing. Below I list a couple simple steps to demo the problem. Both machines I tested were Windows 7, Office 2010 SP2 with the latest patches on both:

First, take a picture of a range:
camera problem 1

Second, right-click and choose Size and Properties (or Alt-JP-O for the mouse-averse). Note that the height and width are listed as 75% and the original size is listed as bigger than the current size:
Post_0047_camera_problem_2

Finally, hit the Reset button and see your picture magically grow! Note that the height and width are now shown as 100% and we’ve achieved the “Original Size”:
Post_0047_camera_problem_3

Post_0047_camera_problem_4

In my limited testing it seems to always be a factor of 75%. So now my code uses ScaleWidth 0.75. I set it as a Const, because talk about a magic number!

Anybody know the cure for this? I searched, and though the camera tool has a fairly rich history of bugs, I didn’t see this behavior mentioned anywhere.

P.S. I know that it’s really more than 33%.

Conditional Formatting Per-Row Color Scales

If you want to compare all the numbers in a range, you can apply a conditional formatting color scale to the entire area and it works just fine. However, sometimes I want to compare the data on a per-row basis. Here’s two examples of data that could use per-row color scales:

same color scale throughout 11

The first, above, mixes values and percents. All the percents are red – the low end of the scale – because they equate to numbers between 0 and 1, and they’re getting compared to sales values between 1 and 100.

same color scale throughout 2

The second mixes sales from a large and small business. The sales for the small business are all shown as low – red – because they’re generally less than 1/100th of the sales of the large corporation.

In both cases I just want to compare the cells in each row to each other. Doing that, the second example looks like this, showing the relative sales within the company and year:

per row color scale 1

VBA to Apply Per-Row Color Scales

As far as I can tell, there’s no quick built-in way to apply color-scales (or icon sets or data bars) on a per-row basis. Instead you need to apply them one row at a time. So, of course, I wrote some VBA.

I’ve long been intimidated by Excel 2010’s conditional formatting object model, at least when it comes to non-formula conditions. But one day I answered this StackOverflow post about per-row color scales and decided to dig deeper.

For that answer I turned on the Macro Recorder, applied a color scale, and then called the generated code in a loop for each row. A better approach is to copy an existing row with the color scale you want and paste it over each row.

The simplest version of this is to copy all formatting in a source row and paste it to a target row. However, I’d prefer to grab only the color scale and paste it, ignoring other formats such as borders, text styles and other conditional formats.

If you turn on the Macro Recorder and apply a 3-gradient color scale to a range, you get something that looks like this, with the last five lines repeated two more times:

Selection.FormatConditions.AddColorScale ColorScaleType:=3
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _
        xlConditionValueLowestValue
With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
    .Color = 7039480
    .TintAndShade = 0
End With

Note that it adds a ColorScale and then moves it to the top of the conditional formatting stack with SetFirstPriority.

I discovered a quirk when I tried to modify the above code to do some simple looping through the conditional formatting settings in a range. I tried something like this:

Dim fc As FormatCondition
For Each fc In Selection.FormatConditions
    Debug.Print fc.Application.Name
Next fc

That makes sense right? Set an object to a FormatCondition in order to loop through all the FormatConditions. However, if Selection only has color scale conditional formatting, you’ll get a “Type Mismatch” error on the “For Each fc” line. Turns out you need to declare fc as a ColorScale. Then the above code will run and will only cycle through the ColorScale objects.

So here’s the workhorse of my code. It’s called by the main module and loops through a target range, applying the color scale from the source range:

Sub SetRangeColorScale(rngTargetSection As Excel.Range, csSource As Excel.ColorScale)
Dim csTarget As ColorScale
Dim csCriterion As ColorScaleCriterion

Set csTarget = rngTargetSection.FormatConditions.AddColorScale(csSource.Type)
rngTargetSection.FormatConditions(rngTargetSection.FormatConditions.Count).SetFirstPriority
For Each csCriterion In csSource.ColorScaleCriteria
    With csTarget.ColorScaleCriteria(csCriterion.Index)
        .Type = csCriterion.Type
        .FormatColor.Color = csCriterion.FormatColor.Color
        .FormatColor.TintAndShade = csCriterion.FormatColor.TintAndShade
    End With
Next csCriterion
End Sub

Below is my main routine. It allows you to choose Row or Column orientation, so you can paste the color scales by-column if you wish. The SectionIncrement variable specifies how many rows at a time to paste the color scale, so you could apply the comparison over two or more rows (or columns) at a time.

Note that in this module, objSourceCondition is declared as an object and tested to see if it’s a ColorScale type of FormatCondition:

Sub CopyColorScaleInSections()
Dim rngSource As Excel.Range
Dim rngTarget As Excel.Range
Dim ws As Excel.Worksheet
Dim objSourceCondition As Object 'we'll test for ColorScale
Dim rngTargetSection As Excel.Range
Dim FillDirection As String
Dim IncompatibleRangeError As String
Dim SectionIncrement As Long
Dim SectionsCount As Long
Dim i As Long

'change the settings below to suit
Set ws = ActiveSheet
Set rngSource = ws.Range("B2:E2")
Set rngTarget = ws.Range("B3:E7")
FillDirection = "Rows"
SectionIncrement = 1

'deletes all existing formats
'you might want to change to just delete
'ColorScales, but for demo purposes
'this works well
rngTarget.FormatConditions.Delete
'checks whether the settings above work together
If Not CompatibleRanges(rngSource, rngTarget, SectionIncrement, _
        FillDirection, IncompatibleRangeError) Then
    MsgBox IncompatibleRangeError, vbOKOnly + vbExclamation
    GoTo exit_point
End If

'determine how many sections of rows or columns
'we'll be pasting over
If FillDirection = "Rows" Then
    SectionsCount = rngTarget.Rows.Count / SectionIncrement
ElseIf FillDirection = "Columns" Then
    SectionsCount = rngTarget.Columns.Count / SectionIncrement
End If

For i = 0 To SectionsCount - 1
    'set an individual section to be pasted over
    If FillDirection = "Rows" Then
        Set rngTargetSection = rngTarget((i * SectionIncrement) + 1, 1) _
            .Resize(SectionIncrement, rngTarget.Columns.Count)
    ElseIf FillDirection = "Columns" Then
        Set rngTargetSection = rngTarget(1, (i * SectionIncrement) + 1) _
            .Resize(rngTarget.Rows.Count, SectionIncrement)
    End If
    For Each objSourceCondition In rngSource.FormatConditions
        'test if it's a ColorScale - 3
        If objSourceCondition.Type = 3 Then
            SetRangeColorScale rngTargetSection, objSourceCondition
        End If
    Next objSourceCondition
Next i

exit_point:
End Sub

Obviously, when you do this you end up with a passel of conditional formatting rules, so don’t be surprised!

rule for each row

Here’s the function, called from the main routine above, that checks whether the source and target ranges are compatible:

Function CompatibleRanges(rngSource As Excel.Range, rngTarget As Excel.Range, _
    SectionIncrement As Long, FillDirection As String, _
    ByRef IncompatibleRangeError As String) As Boolean

'no #DIV/0
If SectionIncrement = 0 Then
    IncompatibleRangeError = _
    "You can't use an increment of 0"
    GoTo exit_point
End If
'can't specify a SectionIncrement bigger than the target range
If (FillDirection = "Rows" And rngTarget.Rows.Count < SectionIncrement) Or _
   (FillDirection = "Columns" And rngTarget.Columns.Count < SectionIncrement) Then
    IncompatibleRangeError = _
    "Target range must have at least" & vbCrLf & _
        SectionIncrement & " rows."
    GoTo exit_point
End If
'target range rows or columns must be
'evenly divisible by the SectionIncrement
If (FillDirection = "Rows" And rngTarget.Rows.Count Mod SectionIncrement <> 0) Or _
   (FillDirection = "Columns" And rngTarget.Columns.Count Mod SectionIncrement <> 0) Then
    IncompatibleRangeError = _
    "Target range " & FillDirection & " must be" & vbCrLf & _
         "evenly divisible by " & SectionIncrement & "."
    GoTo exit_point
End If
'target range width or height has to match
'source range width or height
If Not (rngSource.Rows.Count = rngTarget.Rows.Count Or _
        rngSource.Columns.Count = rngTarget.Columns.Count) Then
    IncompatibleRangeError = _
    "Source and Target ranges must have" & vbCrLf & _
        "either the same number" & vbCrLf & "of rows or columns."
    GoTo exit_point
End If

exit_point:
CompatibleRanges = IncompatibleRangeError = ""
End Function

I’ve run this code successfully on up to 10,000 rows. It took about 7 seconds. I did notice that deleting 9,900 of those rows afterwards takes a while, and that the workbook can then act sluggish until it’s saved. I’m not sure what the issue is.

No download right now, but I’m planning to whip up a workbook that expands this to IconSets and DataBars and whatever else I can cram in there. So look for that in a week or so.

Conditional Formatting Color Scales Based on Other Cells

With formula-based conditional formatting, it’s pretty easy to base the formats on other cells in the workbook, simply by referring to those cells in the formula. However, it’s more complicated if you want color scales derived from values in another range. In this post I discuss two ways to base color scales on another range. The first uses the camera tool while the second is a VBA subroutine that mimics conditional formatting.

Below is an example of what I’m talking about. The color formatting isn’t based on the values in the pivot table. Instead, it reflects the values in the second table, each cell of which contains the difference from the previous year in the pivot table. The colors range from red at the low end to green at the high end:

ormat with camera tool 1

So, here’s my two approaches to doing this:

Using the Camera Tool

This method uses Excel’s under-publicized camera tool, which creates a live picture linked to a group of cells. In this case the formatting is applied to a pivot table, but you can do it with any range. Here’s the steps:

  • Create the range of formulas that you’ll base the conditional formatting on.
  • Format the numbers in that range to be invisible, by using a custom format of “;;;”. All you want to see is the conditional formatting.
  • Use the camera tool to take a picture of the entire pivot table and paste it over the range you just created, lining up the conditionally formatted cells. Set the picture to be completely transparent, using the “no fill” setting. This way you can see through the picture to the conditionally formatted cells underneath.

The result will be like the illustration below. The source pivot table is in rows 11 to 18, and you can see that the picture starting in row 2 is linked to it. The cells underneath the picture contain the formulas referring to the pivot table. The conditional formatting is based on these cells, whose text is invisible because of the custom format.

format with camera tool 2

One thing to be aware of is that the picture doesn’t update until there’s a worksheet recalculation. You may have to force recalculation with F9 to have the picture update.

For one project I augmented this method by writing code that let me toggle back and forth between the values in the pivot table and the values the conditional formatting is based on.

Using VBA to Create “FauxMatting”

As the heading implies, this method attempts to replicate conditional formatting using VBA. The following subroutine takes two ranges – a source and a target range – as its arguments. It finds the highest and lowest values in the source range. It assigns each of those values a color in a scale from green to red, with white in the middle. This is done by dividing the range of values source values into 255 increments. The colors are then assigned to the target range:

Sub ConditionalFauxmatting(rngSource As Excel.Range, rngTarget As Excel.Range)
Const NUMBER_OF_INCREMENTS As Long = 255
Dim MinValue As Double
Dim MaxValue As Double
Dim ScaleIncrement As Double
Dim ScalePosition As Long
Dim var As Variant
Dim CellColor() As Long
Dim i As Long, j As Long

If Not (rngSource.Rows.Count = rngTarget.Rows.Count And rngSource.Columns.Count = rngTarget.Columns.Count) Then
    MsgBox "Source and Target ranges must be" & vbCrLf & "same shape and size"
    GoTo exit_point
End If
MinValue = Application.WorksheetFunction.Min(rngSource.Value)
MaxValue = Application.WorksheetFunction.Max(rngSource.Value)
'divide the range between Min and Max values into 255 increments
ScaleIncrement = (MaxValue - MinValue) / NUMBER_OF_INCREMENTS
'if all source cells have the same value or there's only one
If ScaleIncrement = 0 Or rngSource.Cells.Count = 1 Then
    rngTarget.Cells.Interior.Color = RGB(255, 255, 255)
    GoTo exit_point
End If
'assign all the values to variant array
var = rngSource.Value
ReDim CellColor(UBound(var, 1), UBound(var, 2))
For i = LBound(var, 1) To UBound(var, 1)
    For j = LBound(var, 2) To UBound(var, 2)
        'the scale position must be a value between 0 and 255
        ScalePosition = (var(i, j) - MinValue) * (1 / ScaleIncrement)
        'this formula goes from blue to red, hitting white - RGB(255,255,255) at the midpoint
        CellColor(i, j) = RGB(Application.WorksheetFunction.Min(ScalePosition * 2, 255), _
        IIf(ScalePosition < 127, 255, Abs(ScalePosition - 255) * 2), _
        IIf(ScalePosition < 127, ScalePosition * 2, Abs(ScalePosition - 255) * 2))
    Next j
Next i
'assign the colors stored in the array
'to the target range
With rngTarget
    For i = 1 To .Rows.Count
        For j = 1 To .Columns.Count
            .Cells(i, j).Interior.Color = CellColor(i, j)
        Next j
    Next i
End With

exit_point:
End Sub

The result looks like this:

format with VBA

I’m not sure how practical this is, but it was fun to figure out! Obviously, you’d want to tie this to a worksheet or pivot table event to update the formatting when the values change.

Here’s a workbook demonstrating these two methods.

Unified Method of Pivot Table Formatting

In preparation for my big annual reporting push I’ve developed a (partial) Unified Method of Pivot Table Formatting. My motivation was to define a system that allows me to copy pivot tables as values while preserving the formatting, and that increases formatting flexibility. Simply stated the Unified Method is:

“Use Conditional Formatting for Everything, and Apply Every Conditional Format to the Entire Pivot Table.” *

That’s right. No built-in “PivotTable Styles,” no field-level conditional formats, and no more just selecting the whole table, drawing a border around it and hoping “Preserve cell formatting on update” works.

* Excel 2007 and later. Applies only to formula-based conditions, e.g., not to color scales. Other restrictions apply.

Formatted Pivot Table

Above is a section of a world population pivot table. It has the following conditional formats:

  • The header row is colored orange with a black border around each cell.
  • There’s a black border to the left and right of the table.
  • Subtotal rows are bold with a black border above and below but no interior border, and are the same color as the header row.
  • Detail row cells are surrounded by a light gray border.
  • There are no borders between columns A and B, as Column A is only one pixel wide and flops over into Column B, as with “Oceania Total.”
  • Country rows have alternate banding by country.
  • State/Province rows’ population number font is gray

That’s quite a list, I think you’ll agree. In the past I might have used regular formatting, pivot table styles and field-level conditional formatting. I’d like to avoid all of those approaches, for the following reasons:

Regular Formatting: By “regular formatting” I mean something like selecting the whole pivot table and applying an outside border. This requires the pivot table setting “Preserve cell formatting on update” to be turned on. I’ll admit I’ve never mastered the quirks of this setting, so I’d like to just avoid it.

I’ve already found things, like header row word-wrapping, that may make me relent on this one.

Built-in PivotTable Styles: I really don’t like the built-in pivot table styles, for a few reasons:

  • The text and cell colors are ugly to the point of unusability. They almost always need modification.
  • Modifying them is a pain. The names for pivot table parts are weird. For example, what’s a “First Row Stripe,” and how does “Column Subheading 2” compare to “Subtotal Column 2?” So I do a lot of guessing and backing out of the dialog to see if I guessed right. Very clunky.
  • Pivot Table Modify Style Dialog

  • Finally, if you copy the pivot as values these formats disappear, although John Walkenbach has a solution for that.

Field-level Conditional Formatting: The field-level conditional formatting that became available in Excel 2007, and that I discuss in Re-Apply Pivot Table Conditional Formatting, is certainly better than the pivot table styles. But, again, the formats disappear when you copy the pivot table as values. And you can only use them to format the value fields of a pivot table, so for something like alternate row banding that includes row labels you need to apply the rule twice.

THE “UNIFIED” APPROACH
So, instead of the approaches above, I apply every conditional format to the entire pivot table. I use the ModifyAppliesToRange method, as discussed in the post linked above, to re-apply conditional formatting to the entire pivot table when it’s refreshed. This keeps all the formatting intact when I copy the table as values. It also allows me to easily apply formatting to specific columns and rows.

Note that in the Extend Pivot Table Conditional Formatting Post I only dealt with the rows of the pivot table that had data. In the example file at the end of this post I’ve extended the code to include the entire pivot table.

Two Examples
Since I’m applying the conditional formatting to the whole pivot table, the conditions sometimes need to specify row or column numbers. For example, I only want to gray the text for State/Province rows in columns D and E. That condition looks like this:

=AND(COLUMN(A1)>=4,$C1<>"")

This simply says if column C is blank, gray the text from Column D to the right. I could also specify less than or equal to 5 (column E), but since the conditional formatting is limited to the pivot table that’s not necessary.

Another part that was fiddly is not showing borders between columns A and B. To do this requires two formulas, one to negate column A’s right border, another to blank out column B’s left border. Here’s the formula and setup for column A:

No Border Formatting

The order of the rules is very important with this and other conditions. These “no-border” formats need to be before the formats with the borders.

A Couple More Things

I found this post harder to write than most. Although I think this is an interesting and helpful approach, I don’t know how clear I’ve been. If you have any questions, let me know.

It’s worth restating that the Unified Method of Pivot Table Formatting really only works for Excel 2007 onwards. Earlier versions limit you to three conditional formats in a given cell. Also, it only works for formula-based conditional formatting, i.e., not for color scales, icons, etc.

You can download a workbook with the pivot table shown above. It also includes the code to extend the conditional formatting to the whole table after it’s refreshed.

Preview Excel Custom Formats


(Enter a format in column A and something in column B to preview the format.)

I was thinking of doing a simple post (hah!) on using Excel’s TEXT function to transform numbers to text, in order to match them to ID-type numbers from databases. One of my recurring work tasks is matching a host of possible school IDs from databases (text) to those in spreadsheets (numeric). I frequently use formulas like:

INDEX(tblFromCsv[School_Name],MATCH(TEXT(Numeric_ID,"0"),tblFromCsv[Text_Id],0))

Then recently a post here was featured on Chandoo’s site, along with some from other blogs – increasing my lifetime page views by about 30%. Searching his post for complimentary comments, I saw a couple along the lines of “Thanks for the great links, especially the one from Bacon Bits.”

Mike’s post is indeed a a beauty. It shows how to use custom number formats and create a percentage format like that shown in the first two rows of the interactive workbook above. It got me thinking about what formats you can specify in the TEXT function. It turns out anything you can enter as a custom format works for the TEXT’s Format argument, with very similar results. For example, this formula will format whatever’s in A1 with a format specified in B1:

=TEXT(A1,B1)

This got me thinking about creating a utility that shows the results of any custom format. Just like what you could get by using Excel’s custom format dialog or one line of VBA code, only a lot more work :). Although to be fair, Excel’s custom format dialog doesn’t show color:

Custom number format with no color preview

The reason TEXT doesn’t show color is that Excel functions – native and user-defined – don’t change the format of a cell. TEXT may seem like it’s breaking that rule, but it just returns a string that mimics the specified formatting.

So, adding color without VBA became my excuse reason for creating this tool. To do so, I used conditional formatting and an additional 29 columns of formulas. You can check them out by scrolling right in the workbook above. (You can also download it by using the button at the bottom of the workbook.)

There are two general types of custom formats, so my first task was to determine which kind is being used. The first has four different conditions in the form:

Positive number formats; negative number formats; zero formats; text formats

You can use less than four conditions. If you use only one, negative numbers and zero will use the positive format. If you use two, then zeros get the positive format.

The second type of custom form is more free-form and allows you to enter two custom conditions, and corresponding formats, along with a third format that covers all conditions not met by the first two. The conditions are specified using comparison operators enclosed in brackets like “[=]” “[<>]” “[>]”, etc. The form is:

1st condition and formats; 2nd condition and formats; formats for unmet conditions

Rows 4 through 6 above have some examples. Keep in mind that these custom conditions are evaluated from left to right, and when one is met the evaluation stops, like a VBA If statement.

This Microsoft page has a good explanation of the conditional formats including both of these types.

Determining which of the two types is being is used pretty easy. If the format contains any comparison operators inside of brackets then “Has custom conditions” in column H is true. I used an array formula that searches the format for one of the operators listed in D15:D20:

{=IF($F2,SUM((ISERROR(SEARCH(main!$D$15:$D$20,main!A2))=FALSE)*1)>0,"")}

The rest of the 29 columns contain equally convoluted formulas that tease out the various conditions and whether they have associated colors. These are summarized in columns J:M and N:Q.

The conditional formatting uses COUNTIF. COUNTIF is the only function I know that understands comparison operators combined with numbers in a string. For example, if you have the numbers 1 to 10 in cells A1:A10 and “>5” in B1 you can do this:

Countif with comparison in cell

So I ended up with a conditional format for each possible color, like this:

=INDEX(N2:Q2,MATCH(1,COUNTIF(B2,J2:M2),0))="[Red]"

It’s an array formula, but for some reason in conditional formatting you don’t have to enter them with Shft-Ctrl-Enter and you don’t get the curly brackets. If anybody knows how conditional formatting recognizes array formulas, I’d like to hear.

I know of two things that don’t work correctly in this tool:

  • Text is sometimes colored when it shouldn’t be. If a text color isn’t explicitly implied it should not be changed, unless the general format is used for the positive condition. With this tool it uses the positive condition format in all cases.
  • If you put a color or custom condition, things that are enclosed in brackets, inside of quotes, this will still recognize them as colors or conditions. So don’t do that, at least for testing.

I could fix the first, but I’m not sure about the second. If you see any other failings, feel free to leave a comment.

I mentioned that this all could be done with one line of code. Assuming you have a number in A1 and format in B1, this line of code will apply the format to the number. Note that you need to format B1 as text so you can enter formats like 0000 – without quotes – and not have Excel convert them to a single zero.

Range("A1").NumberFormat = Range("B1")

I learned a ton from doing this, and now have a much more detailed understanding of custom formats. Have you done any projects that were less-than-practical, but rewarding?

Conditional Formatting Digital Clock

I was staring at a video player the other day and thinking about digital clocks, specifically, of course, digital clocks created in Excel. As I imagined, there are quite a few out there: Juan Pablo Gonzalez already had one on DDOE back in 2004, Andy Pope’s is indistinguishable from the real thing, and Tushar Mehta’s is accurate to within one nanosecond every three years. But as far as I can tell there aren’t any created using conditional formatting. Let me know if I’m wrong, but meanwhile here’s a conditional formatting digital clock in a live workbook.

As the notes in the worksheet above say, you can update this clock by clicking in a cell and hitting F9. Not very convenient, but the best I can do without macros. (See the download at the end for full automation). You can adjust the time to your location, instead of that of your server, with the “Hour Offset” setting. To see the full works click on the second worksheet tab.

My basic idea was to use conditional formatting cell borders to form the digits. Each digit would consist of two cells on top of each other.

The first issue was how to have doubled lines for cell borders. Conditional formatting doesn’t have this option. Regular cell borders do though, so the answer was to put double line borders around all the digit cells and then have the conditional formatting “erase” the unneeded ones.

border settings table

The formatting feeds from this grid, which you can see on the second worksheet. Each clock digit is formed from two cells, the “top” and “bottom.” Each of the four borders for each cell has a 0 or 1 setting.

I originally had the table rows filled with 1, 2, 4 and 8 for each cell, thinking to roll the four numbers up into something like a composite enumerated value. Then I tried to use Mod to parse the rolled-up result for each half-digit. If that sounds confusing, it should! I eventually realized that since I essentially needed to determine if each border’s “bit” was on or off, I should just use a table with zeros and ones.

The conditional formatting formula, listed below, finds the relevant digit and it’s top or bottom position and checks whether it’s set to 0. If so, the conditional formatting “erases” the existing border. Otherwise the original double border is left in place.

There are actually four very similar formulas. The only thing that changes is the …”,1)=0″ part at the end. That’s checking the first column, i.e., the left border. The other formulas check, the 2nd, 3rd and 4th columns (the top, bottom and right borders).

=INDEX($R$6:$U$25,
SUMPRODUCT(
($P$6:$P$25=$S1)*
($Q$6:$Q$25=(MID($T$1,((COLUMNS($A:A)+1)/2),1)))*
(ROW($P$6:$P$25)-ROW($P$5)))
,1)
=0

It’s a two-dimensional Index formula. The most interesting thing is that the row dimension is determined by a Sumproduct formula, which finds the row that has the correct digit and top or bottom position. I’ll try to do a short post on this sometime, or if anybody has a good link, let me know.

clock's off button

This digital clock requires Excel 2007 or 2010 because there are four conditions per cell, and Excel 2003 only supports three. I could maybe figure a way around that, but… nah!

You can download the Excel 2007/10 .xlsm zip file, complete with “clocks on / clocks off” button.

A Workbook-Hooker with no Ribbon-related fatalities

I’ve been working on an addin that uses application-level events to “hook” certain “target” workbooks as they open, in order to control menus and other functionality for the target workbooks. I like this setup because the code is all in the addin, so code updates don’t bother users and they don’t have to enable macros.

The Basics

The application class is created when the addin starts, and application-level events track the opening and closing of target workbooks. When a target opens, a workbook class is instantiated. That gets added to a dictionary object that contains all currently open target workbooks. The workbook class shows the ribbon tab when the workbook is activated and hides it when the workbook is deactivated.

I had never created an addin like this using ribbon menus. Creating a new ribbon group is easy using Andy Pope’s RibbonX Visual Designer. And I added the ribbon loss-of-state insurance Ron de Bruin demonstrates. But the ribbon did cause problems when I tried to address a couple of potential usage situations.

The Tricky Parts

If the addin is not checked in the Addins dialog, I want it to behave well when a user does check it. This means that if a target workbook is already open, the menu should be shown when the addin starts. The menu should also be shown if a user opens Excel by clicking on a target workbook in Windows Explorer. I tried to set this up in the addin’s ThisWorkbook module by calling initialization code from the Addin_Install and Workbook_Open events. However, this consistently crashed Excel in these two situations. Somehow my code was colliding with the ribbon’s instantiation. I tried to solve this by delaying initialization with Application.OnTime. This worked for the addin-activation scenario, but not for the Windows Explorer one. My code was somehow trying to run at the same time, or before, the ribbon’s code.

Finally, finally, it hit me that the solution was to call all my initialization code from the Ribbon_OnLoad event. That seems to have fixed the problem, and now there’s no code in the addin’s ThisWorbook module at all.

One other thing I learned was that an application-level Workbook_Open event is fired when you attempt to re-open an open workbook, either from Windows Explorer or in Excel. This could lead to trying to re-add a workbook to the Dictionary if the user accidentally tried to open an already open workbook, so I just re-load the dictionary each time.

The Code

(You can also follow the link at the end of this post to downdoad the addin and two targets.)

Here’s the Application Class module, called clsApplication. Along with hooking target workbooks when they open, it removes them from the collection when they’re closed, using the application’s BeforeClose and Deactivate events.

Public WithEvents App As Excel.Application
Private mboolWbClosing As Boolean

Private Sub App_WorkbookOpen(ByVal wb As Workbook)
If WbIsTargetWorkbook(wb) Then
    FillDictionary
End If
End Sub

Private Sub App_WorkbookBeforeClose(ByVal wb As Workbook, Cancel As Boolean)
'The last close might have been cancelled
mboolWbClosing = False
If gdicTesterWorkbooks.Exists(wb.Name) Then
    'It might be closing, but the close might be cancelled
    mboolWbClosing = True
End If
End Sub

Private Sub App_WorkbookDeactivate(ByVal wb As Workbook)

If mboolWbClosing Then
'Okay, it's really closing
    If gdicTesterWorkbooks.Exists(wb.Name) Then
        gdicTesterWorkbooks.Remove wb.Name
    End If
    mboolWbClosing = False
End If
End Sub

This is the clsTargetWorkbook class.

Public WithEvents wb As Excel.Workbook

Private Sub Class_Initialize()
SetRibbonVisibility True
End Sub

Sub wb_Activate()
SetRibbonVisibility True
End Sub

Sub wb_Deactivate()
SetRibbonVisibility False
End Sub

Last is a module with the remaining code. It includes global variables to track the comings and goings of the ribbon, along with the class and dictionary declarations. Below that is the section that helps retrieve the ribbon reference should it be lost, followed by the subs for the actual ribbon events. Finally, there’s routines to manage the application class and dictionary, test for target workbooks, and show and hide the ribbon. (It probably goes without saying that the real version doesn’t use workbook names to test for target workbooks.)

'thanks to Rory Archibald and Ron de Bruin for Ribbon
'loss-of-state prevention code
'http://www.rondebruin.nl/ribbonstate.htm

Public gRibbon As IRibbonUI
Public cApplication As clsApplication
Public cTargetWorkbook As clsTargetWorkbook
Public gdicTesterWorkbooks As Object
Public gboolShowRibbonTab As Boolean

#If VBA7 Then
    Public Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef destination As Any, ByRef source As Any, ByVal length As Long)
#Else
    Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef destination As Any, ByRef source As Any, ByVal length As Long)
#End If

#If VBA7 Then
    Function GetRibbon(ByVal lRibbonPointer As LongPtr) As Object
#Else
    Function GetRibbon(ByVal lRibbonPointer As Long) As Object
#End If

Dim objRibbon As Object
CopyMemory objRibbon, lRibbonPointer, LenB(lRibbonPointer)
Set GetRibbon = objRibbon
Set objRibbon = Nothing
End Function

Public Sub Ribbon_onLoad(ribbon As IRibbonUI)
Set gRibbon = ribbon
ThisWorkbook.Names.Add Name:="RibbonPointer", RefersTo:=ObjPtr(ribbon)
ThisWorkbook.Saved = True

'only do our initialization after the ribbon's

InitializeGlobals
FillDictionary
End Sub

Sub InvalidateRibbon()
If gRibbon Is Nothing Then
    Set gRibbon = GetRibbon(Replace(ThisWorkbook.Names("RibbonPointer").RefersTo, "=", ""))
End If
gRibbon.Invalidate
End Sub

Public Sub grpRibbonTester_getVisible(control As IRibbonControl, ByRef returnedVal)
returnedVal = gboolShowRibbonTab
End Sub

Public Sub cmdTester_onAction(control As IRibbonControl)
MsgBox "testing"
End Sub

Sub InitializeGlobals()
Set cApplication = New clsApplication
Set cApplication.App = Application
Set gdicTesterWorkbooks = CreateObject("Scripting.Dictionary")
End Sub

Sub FillDictionary()
Dim wb As Excel.Workbook
Dim cTargetWorkbook As clsTargetWorkbook

Set gdicTesterWorkbooks = Nothing
Set gdicTesterWorkbooks = CreateObject("Scripting.Dictionary")
For Each wb In Workbooks
    If WbIsTargetWorkbook(wb) Then
        Set cTargetWorkbook = New clsTargetWorkbook
        Set cTargetWorkbook.wb = wb
        gdicTesterWorkbooks.Add cTargetWorkbook.wb.Name, cTargetWorkbook
    End If
Next wb
End Sub

Function WbIsTargetWorkbook(wb As Excel.Workbook)
If wb.Name = "Target1.xlsx" Or wb.Name = "Target2.xlsx" Then
    WbIsTargetWorkbook = True
End If
End Function

Sub SetRibbonVisibility(boolRibbonVisible As Boolean)
gboolShowRibbonTab = boolRibbonVisible
InvalidateRibbon
End Sub

The Download, Should You So Desire

A zipped file with the addin, and two target workbooks. Install the addin, open the workbooks, or vice-versa.

Solving the NPR Sunday Puzzle

The yoursumbuddy official smartphone has two alarms. One wakes me up at the reasonable hour of 6:23, and one goes off at 9:35 every Sunday with a reminder that NPR’s Sunday Puzzle starts in three minutes. Last Sunday’s lent itself nicely to some Excel fun:

Name two fictional characters – the first one good, the second one bad. Each is a one-word name. Drop the last letter of the name of the first character. Read the remaining letters in order from left to right. The result will be a world capital. What is it?

To solve this, I wanted a list of villains and another of world capitals.

I recently realized that Excel’s Data > From Web feature is easier than copying stuff straight from the web. A lot of web lists have weird html formatting and this feature cuts past much of that. So I sucked in a list of villains from kaijuphile.com

Villain List

… and one of capitals from, that’s right, Wikipedia. Now down to work.

With both lists in a sheet, I added a couple of columns for each. For the villains, the first column gets rid of numbers and the word “The.” The 2nd strips out all villains with names longer than one word, per Mr. Shortz’s instructions. Here’s the formula:

=IFERROR(TEXT(SEARCH(" ",B2),""),B2)

Setup

There’s two fun things here:

1. The IfError part is formed backwards from its normal usage. We actually want the part that returns an error when it doesn’t find a space in the villain’s name: a one-word name.

2. However, this means that all the more-than-one-word villains will return a number – the location of the space. The Text part of the formula fixes that by returning blanks for numbers and leaving strings intact. For example Text(23,””) returns a blank, but Text(“twerp”,””) returns “twerp.” Hey, maybe the answer is Antwerp!

For the capitals, there’s just a bunch of columns, each one lopping off one more letter from the beginning. The villainous name forms the 2nd part of the capital, so if we’re lucky one of the froncated (front-truncated) strings will match a villain. The formula is:

=IFERROR(RIGHT($D2,LEN($D2)-COLUMNS($E:E)),"")

Conditional formatting in column E rightwards turns a cell orange if it matches any of the villain names in column C.  And, sure enough:

Iago

“Santiago” yields “Iago,” who as we all know, flew too near the sun and made a lot of people mad.

This means there’s a good fictional character whose name starts “Sant” followed by one more letter. Hmmm… I guess he wasn’t thinking of the Billie Bob Thornton version.

Re-Apply Pivot Table Conditional Formatting

I often use conditional formatting in pivot tables, often to add banding to detail rows and highlights to total rows.  I like conditional formatting in XL 2010 for the most part, but sometimes it’s persnickety.  It seems to change its mind from day-to-day about what’s allowed.

One well-known problem is that if you apply conditional formatting to both your row fields and the data items, like this:
pivot table with intact conditional formatting

and then refresh it, the formatting is wiped from the data (values) area, as shown below:

There are a couple of ways to fix this.  One is to specifically apply the formats to the values area(s), a new feature as of Excel 2007.  Conditional formats added this way aren’t cleared by pivot table refreshes:

apply CF to data area

This works fairly well as long as your data area only includes one values field, but if you are pivoting on multiple values fields, you’ll have to add the rule for each one.  And you can’t specify row fields in this dialog, so you’ll have define the formats again for those areas.  And if you alter the formats you’ll have to do it all again.

For these reasons I’d rather just apply the conditional formatting to the row headings and the values area in one fell swoop.  But I don’t want to visit the condtional formatting dialog to re-expand the range each time a pivot table is refreshed.

So, I wrote the code below to expand the condtional formatting from the first row label cell into all the row label and data area cells:

Sub Extend_Pivot_CF_To_Data_Area()
Dim pvtTable As Excel.PivotTable
Dim rngTarget As Excel.Range
Dim rngSource As Excel.Range
Dim i As Long

'check for inapplicable situations
If ActiveSheet Is Nothing Then
    MsgBox ("No active worksheet.")
    Exit Sub
End If
On Error Resume Next
Set pvtTable = ActiveSheet.PivotTables(ActiveCell.PivotTable.Name)
If Err.Number = 1004 Then
    MsgBox "The cursor needs to be in a pivot table"
    Exit Sub
End If
On Error GoTo 0

With pvtTable
    'format conditions will be applied to row headers and values areas
    Set rngTarget = Intersect(.DataBodyRange.EntireRow, .TableRange1)
    'set the format condition's source to the first cell in the row area
    Set rngSource = rngTarget.Cells(1)
    With rngSource.FormatConditions
        For i = 1 To .Count
            'reset each format condition's range to row header and values areas
            .Item(i).ModifyAppliesToRange rngTarget
        Next i
    End With

    'display isn't always refreshed otherwise
    Application.ScreenUpdating = True
End With
End Sub

The key to this code is the ModifyAppliesToRange method of each FormatCondtion. This code identifies the first cell of the row label range and loops through each format condition in that cell and re-applies it to the range formed by the intersection of the row label range and the values range, i.e., the banded area in the first image above.

This method relies on all the conditional formatting you want to re-apply being in that first row labels cell. In cases where the conditional formatting might not apply to the leftmost row label, I’ve still applied it to that column, but modified the condition to check which column it’s in.

This function can be modified and called from a SheetPivotTableUpdate event, so when users or code updates a pivot table it re-applies automatically. I’ve also added this macro to the Pivot Table Context Menu and some days it gets used a lot.

Building A Workbook Table Class

Tables in Excel 2010 are powerful tools that help me hugely in my work as a data analyst. I use them every day.

Excel 2003 tables (called lists) were worksheet-level objects.  You could give two tables the same name if they were on different sheets, and not hear a word of complaint out of Excel.  In XL 2010 they are workbook-level objects, so you can use any given table name only once in a workbook.  They are also workbook-level in that you can reference a table from any formula in any sheet just by beginning to type its name, same as with a function or a named range.

In VBA, tables, or listobjects, as they continue to be known, are still worksheet-level objects.  You can declare a Worksheet.Listobject but not a Workbook.Listobject.

I’m working on a project where I wanted a Workbook.Listobject class, so I built one.  To do so, I created a new class called cWorkbookTables and added the following code:

Dim m_wb As Excel.Workbook
Dim m_Tables As Collection

Public Property Get NewEnum() As IUnknown
'the following line, added in a text editor,
'creates the ability to cycle through the items with For Each
'Attribute NewEnum.VB_UserMemId = -4
Set NewEnum = m_Tables.[_NewEnum]
End Property

Public Function Initialize(WbWithTables As Excel.Workbook)
Set m_wb = WbWithTables
Refresh
End Function

Public Sub Refresh()
Dim ws As Excel.Worksheet
Dim lo As Excel.ListObject

Set m_Tables = New Collection
For Each ws In m_wb.Worksheets
  For Each lo In ws.ListObjects
    m_Tables.Add lo, lo.Name
  Next lo
Next ws
End Sub

Public Property Get Item(Index As Variant) As Excel.ListObject
'the following line, added in a text editor,
'sets Item as the default property of the class
'Attribute Item.VB_UserMemId = 0
Set Item = m_Tables(Index)
End Property

Public Property Get Count()
Count = m_Tables.Count
End Property

Property Get Exists(Index As Variant) As Boolean
Dim test As Variant
On Error Resume Next
Set test = m_Tables(Index)
Exists = Err.Number = 0
End Property

Note that the code above includes two lines that have to be added in a text editor. The commented lines set the default property for the class, which is Item, and add the ability to enumerate through the class members in a For Each loop. The processes for adding these very nice features are described in various places on the web, including these instructions at Chip Pearson’s site.

In the same workbook I added two tables and ran the code below in a regular module:

Sub TestTableClass()
Dim clsTables As cWorkbookTables
Dim lo As Excel.ListObject
Dim i As Long

Set clsTables = New cWorkbookTables
With clsTables
  .Initialize ThisWorkbook
  Debug.Print "Number of tables in workbook: " & .Count
  For i = 1 To .Count
    Debug.Print "clsTables(" & i & ") name: " & .Item(i).Name
  Next i
  For Each lo In clsTables
    Debug.Print lo.Name & " " & lo.DataBodyRange.Address
  Next lo
End With
Debug.Print "There is a Table1: " & clsTables.Exists("Table1")
Debug.Print "There is a Table3: " & clsTables.Exists("Table3")
End Sub

The results in the Immediate Window look like this:

Number of tables in workbook: 2
clsTables(1) name: Table1
clsTables(2) name: Table2
Table1 $A$2:$B$4
Table2 $A$2:$B$4
There is a Table1: True
There is a Table3: False

For the reasons mentioned at the beginning of this post, this class only works in XL 2007 and 2010.

Workbook Tables Class Intellisense