Archive for August 2007

Positioning a Userform Over a Cell

keepITcool has developed a method to position a userform over a specific range. Finding a range’s screen coordinates is tricky. I usually resort to “close enough”.

He says:

First I found a bug. Excel 97 thru 2007.
The VisibleRange of Pane 2 and 3 (in a 4 pane window) are inconsistent.
depending on the sequence in which the vertical and horizontal split bars are set it will sometimes
return the range of the upper-right pane, sometimes the lower-left… and in both panes it may return activepane.index = 2
I found the cause and a workaround.

I soon got desperate using PointsToScreenPixels with non-standard zoom. Then I found that using XLM macro’s is the only reliable way to consistently get the “crosshair” on the screen under a variety of splits, zooms and display options. Some fiddling to offset from that point in case of frozen panes.. et voila!

You can download RangePos Beta1.zip.

Update: Download RangePos Beta3.zip

Ian’s Favorite Excel Sites

Table Drive Ribbon

Mike Alexander has updated his table driven Ribbon customizer. You can find it here:

http://www.datapigtechnologies.com/Custom_UI_Builder.zip

He says:

The utility now creates and adds a module with all the call-back functions to the newly created buttons, allowing the buttons to work right away.

As always, the source code is open for anyone who wants to build on this and create a better table-driven Ribbon Customizer.

If you try it out, post your comments here.

Collection Add and Functions

When I was creating sample data for Returning a Limited Collection..., I had to fill a bunch of collections with custom classes. Instead of creating the class and adding it to the collection, I created a function that returned the class and use the function call in the Add method. Here's an example:

Set clsGroup = New CGroup
clsGroup.Name = "Group1"
Set colContacts = New Collection
colContacts.Add CreateContact("Dick Kusleika", _
    "Company1", "NE"), "Dick Kusleika"
colContacts.Add CreateContact("John Doe", _
    "Company2", "NE"), "John Doe"
colContacts.Add CreateContact("Jane Doe", _
    "Company2", "MA"), "Jane Doe"
Set clsGroup.Contacts = colContacts
colGroups.Add clsGroup, clsGroup.Name

The CreateContact function looks like this:

Function CreateContact(sName As String, sCompany As String, _
    sState As String) As CContact
   
    Dim clsCon As CContact
   
    Set clsCon = New CContact
   
    clsCon.Name = sName
    clsCon.Company = sCompany
    clsCon.State = sState
   
    Set CreateContact = clsCon
   
End Function

I never thought of calling a function directly from the Add method of a Collection, but I can't think of any reason not to do it.

Most Impressive Excel App?

What's the most impressive Excel application that you've seen?

Today I had an opportunity to revisit Ivan F. Moala's ImageToXcel, and I spent some time looking at the VBA code. It gets my vote. Yowsers!

Other nominations?

Excel 2003 Lessons

Are you still using Excel 2003? Me too. Microsoft has some lessons that you can listen to, or read, I guess. Unfortunately, I can't put them on my iPod and I don't see me sitting in front of my computer listening to a 50 minute lesson on macro security. One of you guys do it and tell me if they're any good. :)

Returning a Limited Collection from a Class

I have a custom class, CGroup, which has children of the type CContact (another custom class). I need to loop through all the CContacts for each CGroup and print out those that meet a certain condition - in this example, those with State property of "NE". Not all CGroups will have a CContact that meets the condition. The CContact class has Name, Company, and State properties. The CGroup class has a Name property and Contacts collection. In addition, it has a read-only ContactsState property that returns a subset of the Contacts collection that have the provided state.

Public Property Get ContactsState(sState As String) As Collection
   
    Dim i As Long
    Dim colTemp As Collection
   
    Set colTemp = New Collection
   
    For i = 1 To mcolContacts.Count
        If mcolContacts.Item(i).State = sState Then
            colTemp.Add mcolContacts.Item(i), mcolContacts.Item(i).Name
        End If
    Next i
   
    Set ContactsState = colTemp
   
End Property

The data looks like this:

Excel Immediate Window

The final report looks like this:

Excel Immediate Window

In my main sub, I could loop through all of the CContacts for each CGroup and test the State property. If I do that, I need to know beforehand how many CContacts I have in that CGroup so I can tell it when (or if) to print the dotted line that separates them. I could create a property in CGroup that returns that number, but as long I'm looping through the whole collection, I figured I might as well grab the ones I need and return a collection with only those CContacts. I'm not sure if this really saves any cycles because I'm creating a new collection and adding to it rather than just increment a Long counter. But it does have the added advantage of cleaning up the non-class code by removing all that testing for the State.

Sub ListNE()
   
    Dim clsGroup As CGroup
    Dim colGroups As Collection
    Dim colConState As Collection
    Dim i As Long, j As Long
   
    Set colGroups = New Collection
   
    FillGroups colGroups
   
    For i = 1 To colGroups.Count
        Set clsGroup = colGroups(i)
       
        Set colConState = clsGroup.ContactsState("NE")
       
        For j = 1 To colConState.Count
            Debug.Print clsGroup.Name, colConState(j).Name, colConState(j).State
            If j = colConState.Count Then
                Debug.Print String(50, "-")
            End If
        Next j
    Next i
   
End Sub

By working with the limited collection, colConState, it's easy to determine when I've reached the last CContact with NE for the State. Since colConState is an empty collection for Group2 (because it has no CContacts with NE), the inner loop never gets run. Even though I don't show it here, it's probably more important that I properly destroy all of my class references using this method.

You can download LimitChildren.zip to see the whole thing if you like.

Double Click to Exclude Numbers

I have a table of numbers and formulas for each row, column, and for the table as a whole. The table is part of a report - the output of the application. The user wants to exclude certain numbers from the calculations after reviewing them. These numbers would be outliers and would skew the results. The calculations are AVERAGE and STDEV functions. If a number is excluded, it needs to still be shown on the reports, but with a strikethrough format.

The obvious course is to modify the formula when the user has identified a cell to exclude. With formulas for every row, column, and for the whole table, that's a pretty big job. An easier way is to change the numbers to text. Both AVERAGE and STDEV ignore text, so this would have the effect of excluding the numbers from the formulas without having to change the formulas. I started with something like this:

With Target
    If .Font.Strikethrough Then
        .Value = CDbl(.Value)
        .Font.Strikethrough = False
    Else
        .Value = "'" & .Value
        .Font.Strikethrough = True
    End If
End With

This is in the worksheet's BeforeDoubleClick event. I use the strikethrough property to determine if the number has already been excluded. The user can double click the number to toggle between inclusion and exclusion. Excluded numbers have an apostrophe put in front of them (making them text) and the font is changed to strikethrough. Included numbers are changed back to a Double (using CDbl) and the strikethrough is removed.

Incidentally, not every number can be excluded. I've applied a particular style to those numbers that can be excluded and I limit the event like this:

If Target.Style.Name = "TBData2" Then

A new wrinkle appeared. Now some of the numbers are actually formulas. That complicates the above code snippet a little.

excel range

With Target
    If .HasFormula Then
        lStart = 2
    Else
        lStart = 1
    End If
   
    If .Font.Strikethrough Then
        .Formula = "=" & Mid(.Formula, Len("=TEXT()"), _
            Len(.Formula) - Len("=TEXT()'',") - Len(.NumberFormat))
        .Font.Strikethrough = False
    Else
        .Formula = "=TEXT(" & Mid(.Formula, lStart, Len(.Formula)) & _
            ",""" & .NumberFormat & """)"
        .Font.Strikethrough = True
    End If
End With

Instead of putting an apostrophe in front of the value to make it text, I surround it with the TEXT function. This has the added benefit of keeping the same number format applied to the text as was applied to the number. When a number is excluded (the Else part), I start with "=TEXT(". Then I repeat the existing formula, removing the equal sign if there was one (Mid(.Formula, lStart, Len(.Formula))). The suffix to this string manipulation is the existing NumberFormat surrounded by double quotes.

When a number is included, the TEXT portion of the formula is removed. The Mid function starts at Len("=TEXT()"), which is a verbose way of saying 7. The length of Mid is the length of the formula, minus the length the text function (including parentheses, the comma that separates the number format argument, and the quotes that surround the number format), minus the length of the numberformat.

This has the strange side effect of converting a number like 3 into a formula like =3 when it's toggled. I can't think of any ill effects of that, but there may be.