VBA Archives - Page 5 of 8

Listing UserForm Accelerator Keys

Posted on February 21, 2014 by Doug Glancy

Towards the end of the last post I showed a form I made to copy query properties from one table to another. That userform has 20 controls and, as always before I post something for your enjoyment, I tried to make is as user-friendly as possible.

So I set the default and cancel properties to the appropriate buttons and arrange the tab order of all the controls. When that’s done I assign accelerator keys to some of the controls. The accelerator property specifies a letter or other key, which when pressed along with the Alt key, activates that control.

In the example above, a helpful but peevish developer has specified the % key as the accelerator, perhaps for the first time in history.

I enjoy the fiddly work of setting tab orders and accelerators. I’d enjoy it more if the tab order dialog weren’t so hard to read.

It’s also hard to tell which controls have which accelerators and whether you’ve already used a certain letter.

So I wrote a bit of code that takes a userform as an argument and prints the relevant control properties to a newly-minted worksheet.

Sub ListUserFormAccelerators(frm As UserForm)
Dim ControlsCount As Long
Dim i As Long
Dim ctl As msforms.Control
Dim ControlName As String
Dim ControlTabIndex As Long
Dim ControlCaption As String
Dim ControlAccelator As String
Dim ControlProperties() As Variant
Dim ws As Excel.Worksheet
Const TableHeaders As String = "TabIndex,Name,Caption,Accerator,Count"

ControlsCount = frm.Controls.Count
ReDim ControlProperties(1 To ControlsCount, 1 To 4)
For i = 1 To ControlsCount
Set ctl = frm.Controls(i - 1)
ControlName = ctl.Name
ControlTabIndex = ctl.TabIndex
ControlCaption = ""
ControlAccelator = ""
'some controls don't have the next two properties
On Error Resume Next
ControlCaption = ctl.Caption
ControlAccelator = ctl.Accelerator
On Error GoTo 0
ControlProperties(i, 1) = ControlTabIndex
ControlProperties(i, 2) = ControlName
ControlProperties(i, 3) = ControlCaption
ControlProperties(i, 4) = ControlAccelator
Next i
Set ws = Workbooks.Add.Worksheets(1)
With ws
.Range("A1:E1") = Split(TableHeaders, ",")
.Range("A2").Resize(ControlsCount, 4) = ControlProperties
With .ListObjects.Add(xlSrcRange, .UsedRange, , xlYes)
.Name = "tblControlProperties"
.ListColumns("Count").DataBodyRange.FormulaR1C1 = "=COUNTIF([Accerator],[@Accerator])"
With .Sort
.SortFields.Add Key:=Range("tblControlProperties[TabIndex]")
.Header = xlYes
.Apply
End With
.Range.Columns.AutoFit
End With
'Want to close without prompt to save
.Parent.Saved = True
End With
End Sub

The code loops through a form’s controls and ultimately adds them all to an array which is dumped into a worksheet created in the code.

You’d call it like this:

Sub HereYouGo()
ListUserFormAccelerators frmCopyTableQuery
End Sub

And the result looks like this (click on it to open in its own, larger, window):

You may notice that some of the accelerators are doubled above. Each pair is for a label, followed by a textbox with no accelerator and then by a checkbox, which has the second occurrence of that acceelator. There’s two things going on here. The first is that if a control isn’t a Tab Stop, like a label, then the accelerator will take you to the next control, in this case the textbox. The second is that I wanted the user to be taken to the associated checkbox if they hit the accelerator again.

I can’t figure out how to call this code from another project. I messed around with Application.VBE.VBProjects, but can’t get it to work. Another nice thing would be the inverse of this code, a routine that would apply the tab order and accelerators from the worksheet to the userform.

Pivot Table Per-Item Color Scales

Posted on December 8, 2013 by Doug Glancy

Let’s take another journey to the nexus of conditional formatting and pivot tables. My latest foray involved adding per-item color-scales to a pivot table, something like this, where the color scale is applied separately to each quarter:

You can see, for example, that the very high sales of $9,999,999 for January in Region 1 affect the color scale for the other cells in Quarter 1. However, the color scale within other quarters are unaffected, and a 99,999 value in Quarter 2 gets the same green that the much higher value did in Quarter 1.

Here’s another view with each month getting its own scale:

Finally, this shows icon sets by region. Notice that although they span each region for all months, the icon sets ignore the subtotals, which is often preferable:

My code allows you to include or include or ignore subtotals in each item’s color scale. I went about this a couple of ways before settling on the PivotTable.PivotSelect method. I learned about this method recently in a comment by Mike Alexander on one of Jeff Weir’s massive DDOE posts. I can’t find any good documentation, but in Excel 2007 forward you can do things like:

pvt.PivotSelect "'Row Grand Total'", xlDataOnly

Select a pivot table’s Row Grand Total area

pvt.PivotSelect "'Region'['East';Data]", xlDataOnly

Select the data rows for the East PivotItem of the Region PivotField

(There is a PivotSelect method in 2003, but these types of statements failed.)

It looks like PivotSelect is the VBA version of clicking, for example, a single subtotal in a pivot table and thereby selecting them all. I figured out the syntax by turning on the Macro Recorder and doing those types of selections:

I’m not crazy about using PivotSelect – I assume all that selecting will slow things down on big pivot tables. On the other hand it seems to work consistently. I had much more complicated code that worked most of the time, but only most.

Here’s the code, which runs in Excel 2007 on:

Sub PivotItemCF(pvtFieldToFormat As Excel.PivotField, IgnoreSubtotals As Boolean)
Dim pvt As Excel.PivotTable
Dim pvtItem As Excel.PivotItem
Dim pvtField As Excel.PivotField
Dim rngTest As Excel.Range

'Lots of selecting!
Application.ScreenUpdating = False

Set pvt = pvtFieldToFormat.Parent
With pvt
For Each pvtItem In pvtFieldToFormat.PivotItems
'A distressing number of possible errors from hidden items.
'If the item has no DataRange ignore it.
On Error Resume Next
Set rngTest = pvtItem.DataRange
If Err.Number = 0 Then
'Specify the Field name in case there are multiple items
'with the same name,for example from Grouping.
'Surround PivotItem names with single quotes in case they have spaces.
pvt.PivotSelect pvtFieldToFormat.Name & "['" & pvtItem.Name & "';Data;Total]", xlDataOnly
'Call routine that does the formatting
FormatRange Selection
End If
On Error GoTo 0
Next pvtItem

If IgnoreSubtotals Then
'Clear the FormatConditions from Row and Column fields
For Each pvtField In pvt.PivotFields
If pvtField.Orientation = xlRowField Or pvtField.Orientation = xlColumnField Then
'I can't figure a test for whether the subtotals are visible
'so just blindly firing away.
On Error Resume Next
.PivotSelect "'" & pvtField.Name & "'[All;Total]", xlDataOnly
If Err.Number = 0 Then
Selection.FormatConditions.Delete
End If
On Error GoTo 0
End If
Next pvtField
.PivotSelect "'Row Grand Total'", xlDataOnly
Selection.FormatConditions.Delete
.PivotSelect "'Column Grand Total'", xlDataOnly
Selection.FormatConditions.Delete
Else
End If
End With

Application.ScreenUpdating = True
End Sub

The FormatRange routine is just Macro Recorder code generated by selecting part of the pivot table and applying a color scale. You can do the same thing for data bars or icons.

In the sample workbook, the code is triggered by a WorkSheet_Change event that fires whenever one of the three yellow data validation cells is changed.

Filter as you type with FilterMatic!

Posted on October 27, 2013 by Doug Glancy

Whenever possible I employ lookups, crosswalks and whining to avoid correcting data by hand. Sometimes my best efforts fail, and I end up fixing lists one funky cell at a time. The horror! Happily I’ve created FilterMatic to ease the pain.

Say for instance, you’re giving a birthday party for a hundred or so of your oldest friends, all born on October 26. You’ve got this handy reference list of names, years of birth and notable accomplishment:

source:http://www.historyorb.com/today/birthdays.php

Meanwhile you’ve got another, very similar, list that calculates their age – with a lookup to the “year” column on the first list – so you can embarrass them by putting it on their place setting. The problem is some names are misspelled and you’re getting #N/A’s.

So you filter to just the #N/A’s and start to fix them. Wouldn’t it be nice if, as you fixed the errors, they were automatically filtered away? It’s true that in modern Excel tables you can do this with right-click>Filter>Re-Apply. But now with FilterMatic your corrections are instantly whisked from sight!

In the example below, I’m fixing the names, at first without FilterMatic running. After the third fix, I start it up. The first thing that happens is the filter is re-applied. After that the filter is re-applied with every change to the table and each fixed row is filtered away.

FilterMatic™ works on worksheet and table filters, re-applying them on the active sheet whenever you change a cell within a filtered area. And with FilterMatic™ there’s no confusing buttons or messy dropdowns. Just turn it on to start filtering! Close it when you’re done! But wait, there’s more! Download now and receive a free puppy!

Here’s the code:

Private WithEvents app As Excel.Application
Private WithEvents wsActive As Excel.Worksheet
'My ShowModal Property must be set to False

Private Sub UserForm_Activate()
Set app = Application
If Not ActiveSheet Is Nothing Then
Set wsActive = ActiveSheet
FilterMatic
End If
End Sub

Private Sub app_SheetActivate(ByVal Sh As Object)
Set Sh = wsActive
End Sub

Private Sub wsActive_Change(ByVal Target As Range)
FilterMatic
End Sub

Private Sub lblFilterMatic_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'apply changes by double-clicking the form
FilterMatic
End Sub

Sub FilterMatic()
Dim lo As Excel.ListObject

Set lo = Selection.ListObject
'if the selection overlaps a table
If Not lo Is Nothing Then
With lo
'Table is in filter mode
If .ShowAutoFilter Then
.AutoFilter.ApplyFilter
End If
End With
Else
'It will only re-apply a worksheet-level filter if
'there's no tables on the sheet.
With wsActive
'if sheet is filtered
If .FilterMode = True Then
'if the selection overlaps the worksheet's filtered area
If Not Intersect(Selection, .AutoFilter.Range) Is Nothing Then
.AutoFilter.ApplyFilter
End If
End If
End With
End If
End Sub

When the form is opened an application object is created. This object monitors all “SheetActivate” events in Excel and sets the activated worksheet to wsActive. There are three events that trigger the filtering code: opening the form, changing something in wsActive or clicking the label in the center of the form.

The FilterMatic sub checks for both ListObject and worksheet-level filters. If the selection at the time of the change intersects one, then that filter is updated. Note that if a listobject is found, it won’t go on to re-apply a worksheet filter. I tried that and couldn’t imagine a reasonable worksheet design that would have both filter types, and anyways the results were weird. Also note that if you change two listobjects at once, the filter would only be applied to one of them: whichever is the Selection.ListObject.

Here’s a workbook with the code and the lists.

And be sure to join the email list so you won’t miss my next exciting product: PivotMasher!

Get Unique Per-Row Values With RemoveDuplicates

Posted on October 10, 2013 by Doug Glancy

This post consists of two topics, both involving VBA’s RemoveDuplicates method. First I discuss an error and a shortcoming in the RemoveDuplicates documentation that have confounded myself and others. After those are cleared up I’ll show how to use RemoveDuplicates to return a two-dimensional array of unique items from a range containing one or more columns.

RemoveDuplicates was added to VBA (along with it’s front-end counterpart Data>Remove Duplicates) in Excel 2007. It’s very handy, allowing you to select one or more columns in a range and and winnow it down to the rows where the combined values of those columns are unique. It does this “in-place,” leaving other areas of the sheet intact.

RemoveDuplicates’ Columns Argument isn’t Really Optional

The Excel 2013 MSDN documentation describes the variant Columns argument as an optional “Array of indexes of the columns that contain the duplicate information. If nothing is passed then it assumes all columns contain duplicate information.” (my emphasis)

Later it gives an example of leaving out the Columns argument to remove duplicates from the entire range:

“The following code sample removes duplicates with all columns from a range.”

ActiveSheet.Range("A1:C100").RemoveDuplicates

However, testing reveals that the above code does nothing. This is confirmed by the perplexed comments of various forum visitors. In truth, you have to specify the columns variant array in all cases. The help example should look like this:

ActiveSheet.Range("A1:C100").RemoveDuplicates Columns:=Array(1,2,3)

If you want to base the removal on just some of the columns in a range, for example columns A and C, you do it like this:

ActiveSheet.Range("A1:C100").RemoveDuplicates Columns:=Array(1,3)

Using a Dynamic Columns Array

If you use RemoveDuplicates in code, there’s a good chance you’ll want to determine the array of column numbers at runtime and not hard-code them as above. As a simple test, I tried something like:

Dim ColumnsToCheck as Variant
ColumnsToCheck = Array(1,3)
ActiveSheet.Range("A1:C100").RemoveDuplicates Columns:=ColumnsToCheck

However this results in a Runtime Error ‘5’ – Invalid Procedure Call or Argument.

After looking around the web a while I found that the answer is to wrap ColumnsToCheck in parentheses, so the code becomes:

Dim ColumnsToCheck as Variant
ColumnsToCheck = Array(1,3)
ActiveSheet.Range("A1:C100").RemoveDuplicates Columns:=(ColumnsToCheck)

I know, from one of my all-time favorite DDOE posts that parentheses force evaluation of what’s inside them. Others on the web said that these parens “coerce” the evaluation of the array. I don’t really see how that applies here, so if you can explain why this works, please leave a comment.

One other note about the Columns variant array – it must be zero-based.

Unique Unique Per-Row Values Array Function

Once I’d sorted out the above points, I was able to use RemoveDuplicates as the basis of a function that returns a two-dimensional variant array containing the unique rows in a range. The range can consist of multiple columns that aren’t necessarily adjacent, as in this table of hometowns and sports of 2008 US Olympic athletes:

In the example above I want to return a variant array of all the unique combinations of the State and Sport fields. The specific use is for a worksheet splitter, where I prompt the user for one or two columns and the cycle through the array of unique combinations, creating a separate workbook for each combination.

The code is simple enough. It takes a range as it’s argument, for example the State and Sport fields above. It copies the range it to a worksheet in a newly added workbook. We then use RemoveDuplicates on the entire UsedRange of that new sheet. Because the columns are now contiguous the code can easily assign the modified range back to a variant array. The temporary workbook is then closed without saving.

Function GetUniqueRowValues(rng As Excel.Range) As Variant
Dim wbTemp As Excel.Workbook
Dim wsTemp As Excel.Worksheet
Dim ColNums As Variant
Dim i As Long

'if only one cell selected then can't pass to two-dimensional array
If rng.Cells.Count = 1 Then
'if the single cell is blank
If rng.Value = vbEmpty Then
Exit Function
Else
GetUniqueRowValues = rng.Value
Exit Function
End If
End If

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'create a temp workbook
'and copy range to it
Set wbTemp = Workbooks.Add
Set wsTemp = wbTemp.Worksheets(1)
With wsTemp
rng.Copy
'rng can consist of non-adjactent columns
'pasting to a new workbook results in a
'new range with only those columns
.Range("A1").PasteSpecial xlPasteValues
ReDim ColNums(0 To wsTemp.UsedRange.Columns.Count - 1)
'Create the array of column numbers for the
'RemoveDuplicates' Columns parameter
For i = LBound(ColNums) To UBound(ColNums)
ColNums(i) = i + 1
Next i
.UsedRange.RemoveDuplicates Columns:=(ColNums), Header:=xlGuess
'assign the values of the remaining,
'non-duplicated rows to the function result
GetUniqueRowValues = .UsedRange
End With
wbTemp.Close False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Function

Note that is the original range was just one cell, the returned variant will not be an array. But you’d test for that before running this in the first place, wouldn’t you?

This code is fast for big ranges, handling over one million rows in less than five seconds on my laptop. On the other hand, it has to open and close a workbook, which takes part of a second and causes screen flicker. It’s a lot more flexible at least than my attempts to modify the Collection technique to handle large ranges with non-adjacent columns.

More Listbox Filtering With the Like Operator

Posted on September 12, 2013 by Doug Glancy

Since posting about filtering a listbox, I’ve been thinking a lot about VBA’s Like operator. I realized I could type in filters such as ‘[4-7]#‘ which matches two-digit numbers between 40 and 79. I raced to my computer to try it out, typed the opening bracket and was halted in my tracks:

It makes sense that a “[” without a “]” is untenable in a Like pattern. It needs the closing bracket to mark the end of the character set. On the other hand, a single “]” is legal and just stands for itself. You can match a left bracket by putting brackets around it, so the following expression in the Immediate Window yields True:

? "[" Like "[[]"

I set to creating a function that would detect the invalid left bracket. I tried testing whether there were more left than right brackets, but since you can have two left ones in a row, and as many right ones as you want, that wouldn’t fly. To avoid a complicated set of tests, I turned to the VBA standby of attempting something inside of On Error statements, something whose failure yields specific and helpful information, like “hey that’s an invalid pattern.”

Here was the first attempt, which seemed to do the trick:

Function ValidLikePattern(LikePattern As String) As Boolean
Dim temp As Boolean
On Error Resume Next
temp = ("A" Like LikePattern)
If Err.Number = 0 Then
ValidLikePattern = True
End If
On Error GoTo 0
End Function

You pass it a pattern and it tests it against the simplest possible string – “A”. My assumption was the test would either pass, if there was no left bracket, or fail if there was. I was wrong on two counts.

The first is that Like actually has three possible outcomes: True, False or Null. It returns Null if either the string being compared or the pattern is an empty string.

Much more important to my function, Like is lazy. It only tests as far as needed. So, while this returns an “Invalid pattern string” message:

? "A" Like "["

This doesn’t:

? "A" Like "A["

It just returns False. I guess Like compares the first characters, sees they match and checks whether the next one is an asterisk, the only character that could match at this point. Since it’s not, Like says “whatever” and quits, ignoring the left bracket’s tenuous status.

I could fix the function – kind of – by using a really long string in place of “A” and force Like to look harder. Instead I surrounded LikePattern in asterisks:

temp = ("A" Like "*" & LikePattern & "*")

This says there could be an infinite number of characters at the beginning of the pattern, so Like needs to be thorough and compare all the way through. I suppose this slows the code. I also guess I don’t need the “*” at the end. At any rate, I can now type a left bracket into the filter textbox without an error:

I updated the sample workbook from the ListBox Filter With WildCards post. It now calls the ValidLikePattern function at the beginning of the main loop. If the pattern isn’t valid, the loop is exited and the filtering stays the same until the next change in the filter textbox. Here’s the updated download.

Help Me Test Table Viewer

As I mentioned at the end of that post, I’m incorporating this logic and a bunch of features into a Table Viewer addin. I think it’s even more “freakin’ awesome” than MenuRighter. I’ve been using it every day. I just added the ability to specify exact matches, “contains”, “begins with”, etc. If you’d like to help me test it, please leave a comment or use the contact form to let me know. Or wait for my next post.

ListBox Filter With Wildcards and Unique Values

Posted on September 2, 2013 by Doug Glancy

This post demonstrates a simple setup to filter a userform listbox as you type into a textbox. The filter uses VBA’s Like operator to pick up matches anywhere within the string. For example, typing “ursumb” matches to “yousumbuddy.” The Like operator allows wildcards, so “/*/201?” matches all dates from 2010 onwards. Like is also case-sensitive, so it can filter by case, or not, as specified. In addition the code uses the tried and true Collection method to allow filtering by unique items.

So, with this list of most popular US girls’ names for 2012 (modified in favor of “Emily”) you can filter and then add Unique and Case Sensitive filters. Note that clicking a name takes you to that row in the table:

Nice, isn’t it? Here’s the main routine, which gets called whenever the text in the filter textbox changes or one of the checkboxes is clicked:

Sub ResetFilter()
Dim rngTableCol As Excel.Range
Dim varTableCol As Variant
Dim RowCount As Long
Dim collUnique As Collection
Dim FilteredRows() As String
Dim i As Long
Dim ArrCount As Long
Dim FilterPattern As String
Dim UniqueValuesOnly As Boolean
Dim UniqueConstraint As Boolean
Dim CaseSensitive As Boolean

'the asterisks make it match anywhere within the string
FilterPattern = "*" & Me.txtFilter.Text & "*"
UniqueValuesOnly = Me.chkUnique.Value
CaseSensitive = Me.chkCaseSensitive

'used only if UniqueValuesOnly is true
Set collUnique = New Collection
Set rngTableCol = loActive.ListColumns(1).DataBodyRange
'note that Transpose won't work with > 65536 rows
varTableCol = Application.WorksheetFunction.Transpose(rngTableCol.Value)
RowCount = UBound(varTableCol)
ReDim FilteredRows(1 To 2, 1 To RowCount)
For i = 1 To RowCount
If UniqueValuesOnly Then
On Error Resume Next
'reset for this loop iteration
UniqueConstraint = False
'Add fails if key isn't UniqueValuesOnly
collUnique.Add Item:="test", Key:=CStr(varTableCol(i))
If Err.Number <> 0 Then
UniqueConstraint = True
End If
On Error GoTo 0
End If
'True if UniqueValuesOnly is false or if
'UniqueValuesOnly is True and this is the
'first occurrence of the item
If Not UniqueConstraint Then
'Like operator is case sensitive,
'so need to use LCase if not CaseSensitive
If (Not CaseSensitive And LCase(varTableCol(i)) Like LCase(FilterPattern)) _
Or (CaseSensitive And varTableCol(i) Like FilterPattern) Then
'add to array if ListBox item matches filter
ArrCount = ArrCount + 1
'there's a hidden ListBox column that stores the record num
FilteredRows(1, ArrCount) = i
FilteredRows(2, ArrCount) = varTableCol(i)
End If
End If
Next i
If ArrCount > 0 Then
'delete empty array items
'a ListBox cannot contain more than 65536 items
ReDim Preserve FilteredRows(1 To 2, 1 To Application.WorksheetFunction.Min(ArrCount, 65536))
Else
're-initialize the array
Erase FilteredRows
End If
If ArrCount > 1 Then
Me.lstDetail.List = Application.WorksheetFunction.Transpose(FilteredRows)
Else
Me.lstDetail.Clear
'have to add separately if just one match
'or we get two rows, not two columns, in ListBox
If ArrCount = 1 Then
Me.lstDetail.AddItem FilteredRows(1, 1)
Me.lstDetail.List(0, 1) = FilteredRows(2, 1)
End If
End If
End Sub

This routine takes advantage of the fact that Collection keys must be unique. If “Unique” is checked on the form, we test each value before adding it to the ListBox’s array.

The FilterPattern string has asterisks at the beginning and end. This is why the filter matches if it’s found anywhere within a table item.

In addition to the girl’s name, an array item also holds the record number for that name. This is used in another subroutine that activates the table row when the listbox selection changes:

Private Sub lstDetail_Change()
GoToRow
End Sub

Sub GoToRow()
If Me.lstDetail.ListCount > 0 Then
Application.Goto loActive.ListRows(Me.lstDetail.Value).Range.Cells(1), True
End If
End Sub

Here’s how it looks when filtering dates:

The speed is quite reasonable for tables with less than 10,000 items. Above that it gets slow, but is still usable all the way up to the limit of 65,536 listbox items. Yikes!

Here’s a workbook with all the code and the name and date tables to fool around with.

An Invitation

I’ve expanded this concept into a full-fledged Table Viewer. I’ve been using it in its alpha state and it’s quite handy for zipping around a big table. Along with the features here, it handles multiple columns, allows you to view only visible rows, and some other stuff. If anybody is interested in testing it out, leave a comment here or use the contact form.

Single Quotes in Worksheet Names

Posted on April 18, 2013 by Doug Glancy

I was working on a function that uses regular expressions to determine whether a potential name for a workbook, worksheet or range contains illegal characters. I started by writing a little routine to determine which characters are illegal for sheet names. Of course, I could have just used one that I knew was prohibited and got the message below. But then I might never have thought about the use of single quotes in worksheet names.

Here’s the code I used:

Sub IllegalWsNameCharacters()
Dim i As Long

With ActiveSheet
.Range("A1").Cells.ClearContents
For i = 0 To 127
On Error Resume Next
.Name = Chr(i)
If Err.Number <> 0 Then
.Range("A1").Value = .Range("A1").Value & Chr(i)
End If
On Error GoTo 0
Next i
End With
End Sub

It cycles through each of the 128 ASCII characters and tries to use it as the ActiveSheet’s name. An error means that character is illegal, at least by itself, so it’s added to the contents of cell A1. I don’t know why I printed to a cell instead of the Immediate window, but it kept me from immediately (ha!) noticing that the first illegal character was a single quote or, as normal people say, an apostrophe.

You can see it doesn’t show up in the cell contents, only in the formula box. That’s because the single quote is the escape character that tells Excel that whatever follows it is text, and part of its duty is to stay quietly out of sight.

At any rate, I saw it and was surprised at it’s illegality. I’m pretty sure I’ve used an apostrophe in a sheet name before. And, sure enough you can:

What you can’t do is use it as the first or last character in a sheet name. And this makes sense, since single quotes are how Excel surrounds worksheet and workbook names that have spaces in them, as in:

='A spaced out name'!A1 * serious_wks_name!A1

All in all, it seems you are best off leaving single quotes out of your sheet names. A quick web search reveals issues with hyperlinks, OLEDB references and Excel Services REST, whatever that is.

Finally, and interestingly, you can name your sheets with some of the “nonprintable” ASCII character codes, i.e., characters 0 to 31, if only through VBA:

ActiveSheet.Name = Chr(8) & " " & Chr(12) & " " & Chr(17) & " " & Chr(15) & " " & Chr(14)

Mind you, I’m not recommending it.

Why Pi is Irrational – In Pictures

Posted on April 9, 2013 by Doug Glancy

I was a good math student in junior high, and I’m sure I did well on all my pi-related homework and test questions. I understood that pi was an irrational number, and knew, theoretically, that it had an endless number of non-repeating decimals. However, I had no real grasp of why it’s irrational. It was just another abstract, memorized math fact. But a few years back a realization came to me. So, in belated celebration of Pi Day on March 14, I offer my pictorial explanation of why pi is irrational.

The realization came when thinking about the formula for an area of a circle, Π r² (pi * r²) where r is the circle’s radius. It dawned on me that the r² referred to a real geometric square with sides and corners and all, not just a letter with a number above it, and that:

Pi represents the number of squares with a side of length r that would fill a circle with a radius of length r.

Therefore, my explanation of why pi’s digits are infinite is that no matter how many squares you put inside a circle, there will always be a smaller “corner” into which you can cram a smaller square. This leaves an even smaller corner for an even smaller square, and on and on without end.

I don’t know whether this is a mathematically valid explanation. But transforming this abstract concept into something I could draw with a pencil pleased me no end.

Pi and VBA

A pencil is one thing, but on Pi Day I decided to illustrate my explanation with Excel and VBA. It took me a really long time! First I tried using shapes, a reasonable, but really bad, idea. I ended up using just one shape, a circle, and a bunch of tiny cells, which are, after all, squares:

The circle above has a radius of 50. When all the squares that fit are filled in, their total area is about 3.08 times that of a square with a radius of 50. In other words, it’s fairly close to pi. If I change the settings to a radius of 100, the number climbs above 3.1, but still short of pi.

Programming this was challenging and fun. Because of the nature of the project I coded some things more loosely than normal. There’s a bunch of global variables, and even a “Select Case True” statement.

I did a lot of Unioning and Intersecting in the code. One thing I rediscovered is a major glitch with the Union statement, which gives you an incorrect cell count for the Union of two overlapping ranges:

Two Miscellaneous Things

My search for a screen-capture-to-animated-GIF program continues. I had been using Cropper, but it was unable to keep up with the circle’s “exit stage left” in the animation above. As you can see, I’m now trying ScreenCast-o-Matic, which has a nice interface, and both desktop and web versions. For $15 I can upgrade and remove their logo from the video, but when I tried this morning their website refused to take my money.

Finally, on Pi Day’s website it claims to be celebrated all around the world. It must be a fairly abstract reference in countries that use the, more logical, DMY date system, e.g., 14/3/2013.

Download!

Here’s a workbook with the code.

VBA FormatConditions – Per-Row ColorScales, DataBars and IconSets

Posted on February 17, 2013 by Doug Glancy

At the end of Conditional Formatting Per-Row Color Scales I said I’d be back with code to selectively copy IconSets and DataBars on a per-row basis as well. It took some doing but it’s now presentable. I learned a lot about programming these types of FormatConditions and I’m going to use this utility to generalize what I learned.

First, here’s a sample of the code in action. Some silly guy has added Icons, Data Bars and Color Scales to the values in Row 1. Now he’s copying only the ColorScales from that first row to the rows below:

I (okay, it’s me) adjust the setting and push the button. The button routine passes the values in the worksheet to the main routine. It’s an expanded version of the code in the previous post, with an addition to delete selected formats. The main procedure is available in the download workbook linked at the end of this post. (The delete code is interesting, and shown later in this post.)

ColorScale, IconSet and DataBar Subroutines

Below are the three subroutines, called from the main procedure, to copy each type of FormatCondition: ColorScales, IconSets and DataBars.

The structure of each of these objects is different. With the exception of the Formula property, ColorScale has no relevant properties in the base object. The properties that need to be copied are all within its ColorScaleCriterion object. IconSets have relevant properties both within the IconSet object and within its IconCriterion object. Finally, DataBars contain no criterion object. All of its relevant properties are set within the base DataBar object.

ColorScale

Here’s the ColorScale subroutine. You can see that the only property in the ColorScale object is the Formula property, which is an interesting one. As far as I can tell this property is only applicable through code. I’ll discuss it more below. It’s only sometimes applicable, and if it’s not it will generate an error when you refer to it. So I surround it with and On Error statement to avoid that.

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)
On Error Resume Next
csTarget.Formula = csSource.Formula
On Error GoTo 0
For Each csCriterion In csSource.ColorScaleCriteria
With csTarget.ColorScaleCriteria(csCriterion.Index)
On Error Resume Next
.Type = csCriterion.Type
On Error GoTo 0
On Error Resume Next
.Value = isCriterion.Value
On Error GoTo 0
.FormatColor.Color = csCriterion.FormatColor.Color
.FormatColor.TintAndShade = csCriterion.FormatColor.TintAndShade
End With
Next csCriterion
End Sub

Aside from Formula, the properties that need to be copied are part of ColorScale’s ColorScaleCriterion object. They are Type, and the Color and TintAndShade shade properties of ColorScaleCriterion.FormatColor.

The Type property specifies whether a criterion is based on a number, percent, percentile or formula. Value sets the value to be used for the Type, for example, the 90th percentile or the appropriate formula. These properties all have their counterpart in the conditional formatting dialog, shown here with a formula for the Min and Max values:

I surrounded the Type and Value assignments in an On Error statement because only some of the criteria have them and you’ll get an error on the ones that don’t. Sheesh, this stuff is confusing!

IconSet

Aside from Formula, the IconSet object has three properties that need to be copied: IconSet, ReverseOrder and ShowIconOnly. IconSet determines the color and type of icons and the others should be obvious:

Sub SetRangeIconset(rngTargetSection As Excel.Range, isSource As Excel.IconSetCondition)
Dim isTarget As IconSetCondition
Dim isCriterion As IconCriterion

Set isTarget = rngTargetSection.FormatConditions.AddIconSetCondition
With isTarget
On Error Resume Next
.Formula = isSource.Formula
On Error GoTo 0
.IconSet = isSource.IconSet
.ReverseOrder = isSource.ReverseOrder
.ShowIconOnly = isSource.ShowIconOnly
For Each isCriterion In isSource.IconCriteria
With .IconCriteria(isCriterion.Index)
.Icon = isCriterion.Icon
On Error Resume Next
.Type = isCriterion.Type
On Error GoTo 0
On Error Resume Next
.Value = isCriterion.Value
On Error GoTo 0
.Operator = isCriterion.Operator
End With
Next isCriterion
End With
End Sub

At the IconCriterion level, there are four properties: Icon, Type, Value and Operator. Icon allows you to change individual icons, just like you can in the user interface. For example, here the gray arrow icon set has been modified to use a green ball in place of the gray up arrow:

Operator sets the relationship of the Icon to the Value. For example, the “>” Operator says to use an up arrow if the cell’s value is greater than the Value property.

DataBar

The DataBar object has no criterion property. All the relevant properties are at the DataBar level. So instead of criteria for the Min and Max, you get the MinPoint and MaxPoint properties. These two made me nervous when I first saw them, as you have to set them via their Modify methods, but that seems to work fine.

Sub SetRangeDataBar(rngTargetSection As Excel.Range, dbSource As Databar)
Dim dbTarget As Databar

Set dbTarget = rngTargetSection.FormatConditions.AddDatabar
With dbTarget
On Error Resume Next
.Formula = dbSource.Formula
On Error GoTo 0
With .AxisColor
.Color = dbSource.AxisColor.Color
.TintAndShade = dbSource.AxisColor.TintAndShade
End With
.AxisPosition = dbSource.AxisPosition
.BarBorder.Type = dbSource.BarBorder.Type
With .BarColor
.Color = dbSource.BarColor.Color
.TintAndShade = dbSource.BarColor.TintAndShade
End With
.BarFillType = dbSource.BarFillType
.Direction = dbSource.Direction
.MinPoint.Modify newtype:=dbSource.MinPoint.Type, newvalue:=dbSource.MinPoint.Value
.MaxPoint.Modify newtype:=dbSource.MaxPoint.Type, newvalue:=dbSource.MaxPoint.Value
.NegativeBarFormat.ColorType = dbSource.NegativeBarFormat.ColorType
With .NegativeBarFormat.Color
.Color = dbSource.NegativeBarFormat.Color.Color
.TintAndShade = dbSource.NegativeBarFormat.Color.TintAndShade
End With
.PercentMax = dbSource.PercentMax
.PercentMin = dbSource.PercentMin
.ShowValue = dbSource.ShowValue = True
End With
End Sub

There’s a whole bunch of properties besides MinPoint and MaxPoint. About half deal with formatting, including formatting of negative values. All of these are analogous to their similarly-named user interface properties:

Deleting Selected FormatConditions

I wrote a routine to delete only certain types of format conditions from a target range. It gets called before the routine to copy the formats. For example, if the routine is copying DataBar formats, we’ll first delete all the existing ones.

It took longer than I expected to get a workable routine, chiefly because my initial attempts were inpossibly slow. Whereas copying all three types of FormatCondition to 1000 rows takes about a second, deleting formats by looping through the whole FormatConditions collection was taking minutes.

The solution was to break the target range into little ranges of 10 rows each and delete the matching conditions from those ranges. I assume this must simplify Excel’s internal indexing of the FormatConditions collection, whatever that means :). This only takes a couple of seconds for a thousand rows.

The other thing to note is that you have to loop backwards through the FormatConditions – just like deleting any Excel object in a loop – or you’ll get a “Subscript out of Range” error:

Sub DeleteFormatConditions(rngTarget As Excel.Range, _
DeleteColorScales As Boolean, DeleteDataBars As Boolean, DeleteIconSets As Boolean)
Dim FormatConditionsCount As Long
Dim DeleteIncrement As Long
Dim DeleteRangeStart As Long
Dim DeleteRangeEnd As Long
Dim DeleteDone As Boolean
Dim rngDelete As Excel.Range
Dim objFormatCondition As Object
Dim i As Long

'Break target range into smaller ranges, which makes deletion go many times faster!
DeleteIncrement = 10
DeleteRangeStart = 1
'Min to keep from going past end of target range
DeleteRangeEnd = Application.WorksheetFunction.Min _
(DeleteRangeStart + DeleteIncrement, rngTarget.Rows.Count)
Do While Not DeleteDone
'rngTarget.Parent is the worksheet
Set rngDelete = rngTarget.Parent.Range(rngTarget.Cells(DeleteRangeStart, 1), _
rngTarget.Cells(DeleteRangeEnd, rngTarget.Columns.Count))
FormatConditionsCount = rngDelete.FormatConditions.Count
'Check each format condition's type and call matching routine
'Step backwards or risk "Subscript out of Range"
For i = FormatConditionsCount To 1 Step -1
Set objFormatCondition = rngDelete.FormatConditions(i)
If DeleteColorScales And objFormatCondition.Type = 3 Then
objFormatCondition.Delete
End If
If DeleteDataBars And objFormatCondition.Type = 4 Then
objFormatCondition.Delete
End If
If DeleteIconSets And objFormatCondition.Type = 6 Then
objFormatCondition.Delete
End If
Next i
If DeleteRangeEnd >= rngTarget.Rows.Count Then
DeleteDone = True
End If
DeleteRangeStart = Application.WorksheetFunction.Min _
(DeleteRangeStart + DeleteIncrement, rngTarget.Rows.Count)
DeleteRangeEnd = Application.WorksheetFunction.Min _
(DeleteRangeEnd + DeleteIncrement, rngTarget.Rows.Count)
Loop
End Sub

The Formula Property

As I mentioned above, each of these FormatConditions has a Formula property. I don’t see a match for this property anywhere in the Excel user interface. According to MSDN, it:

Returns or sets a String representing a formula, which determines the values to which the data bar will be applied.

This property is useful to limit the range of values that will display the conditional format. A typical scenario is when you have a range of numbers containing both positive and negative values. You may want to create more than one conditional format for this range of numbers—one for positive values and another for negative values.

Sure enough, if I apply it to a DataBar definition, like so…

dbDataBar.Formula = "=A1 > -5"

… I get this formatting, where the DataBars are only applied to cells with values greater than negative 5:

If there is a way to do this in the user interface, please let me know!

Miscellaneous:

In my previous post on this, I noted that a recorded macro sets the added conditional format to the first priority and that I was doing the same in my code. However, that’s a bad idea. When copying more than one format it will rearrange their order.
If you are fooling around with this stuff, you’ll notice that recording a macro that modifies existing conditional formatting produces all the code for that formatting, not just for the modification. This can be annoying or useful, depending.
The StopIfTrue FormatConition doesn’t apply to these three objects. You can see that they are grayed out in the Excel dialog.
The ScopeType and PTCondition properties have to do with conditional formatting in pivot tables.

Download!

Here’s a workbook with a working model and all the code.

Conditional Formatting Per-Row Color Scales

Posted on February 3, 2013 by Doug Glancy

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:

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.

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:

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!

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.