Archive for July 2008

The NEW Spreadsheet Page

Finally, I redesigned The Spreadsheet Page. The official launch is Friday, but you can take a sneak peek if you're interested.

Out with FrontPage, and in with Expression Engine. Man, that's some powerful software. The site is all database driven now, so it will be much easier to maintain and update.

Feedback is welcome. If you encounter any major glitches, please post a comment at the blog.

Multiple Add-ins

I'm creating several add-ins that will all use the same top-level menu item. The add-ins will be installed as needed. So someone may have just one and someone else may have half a dozen. The right answer, I think, is to have one controlling add-in that handles the menus (and not much else), but I've already started down another path, so I'm going to see where that leads me.

To identify which add-ins use my top-level menu, I use a CustomDocumentProperty. I can then create a function to determine if any other add-ins are loaded.

Public Function AISAppExists() As Boolean
   
    Dim bReturn As Boolean
    Dim ai As AddIn
   
    bReturn = False
   
    For Each ai In Application.AddIns
        If ai.Name <> ThisWorkbook.Name Then
            If ai.Installed Then
                On Error Resume Next
                    bReturn = Workbooks(ai.Name).CustomDocumentProperties(gsCDPAPP).Value
                On Error GoTo 0
               
                If bReturn Then Exit For
            End If
        End If
    Next ai
   
    AISAppExists = bReturn
   
End Function

In my CreateToolbar procedure:

If Not AISAppExists Then
    Set cButtonMain = Application.CommandBars(1).Controls.Add(msoControlPopup, , , FindHelp)
    cButtonMain.Caption = gsCBMAIN
Else
    Set cButtonMain = Application.CommandBars.FindControl(, , gsCBTAG1)
End If

That gives me a cButtonMain object under which I can build my menu. If a sister add-in exists, then go get the top level menu item. Otherwise, create a new one.

I use two global constants for tagging the controls, gsCBTAG1 and gsCBTAG2. gsCBTAG1 is the same for all related add-ins and is only put on the top level menu item. gsCBTAG2 is different for all related add-ins and is used to tag controls one level below the top level menu item.

In DeleteToolbars:

If Not AISAppExists Then
    Set ctl = Application.CommandBars.FindControl(, , gsCBTAG1)
    If Not ctl Is Nothing Then
        ctl.Delete
    End If
Else
    Set ctls = Application.CommandBars.FindControls(, , gsCBTAG2)
    If Not ctls Is Nothing Then
        For i = 1 To ctls.Count
            ctls.Item(i).Delete
        Next i
    End If
End If

If this is the last app, then delete the top level menu item and be done with it. If there is still a related add-in open, then delete all of the second level menu items for this add-in. I don't tag menu items lower than that because deleting a higher level automatically deletes the lower level.

So the first add-in creates the top level menu item and all subsequent add-ins use it. The last add-in to be unloaded deletes the top level menu item and all previous ones just deleted their portion. It seems to work, but your comments are welcome.

One problem is code duplication. I have very similar code in my toolbar modules in all of the add-ins. A change to any of that code means changing it in several places.

Filter by Selected Cell’s Value, Cell’s Color or Cell’s Font Color

Hi all

After creating and testing a lot of code to filter on normal and on Conditional Formatting colors
I came up with a nice and easy solution I think.

I made this page for Excel 2007
http://www.rondebruin.nl/colorfilter2007.htm

Suggestions are welcome

Ron de Bruin
http://www.rondebruin.nl/tips.htm

Free Excel Stuff

Giveaway of the Day

I like the comments from the OpenOffice users. Jeez, does everything have to be open-source?

List Userform Hotkeys

I hate trying to figure out which hotkeys are available when I need to add a control to a userform, so I wrote a procedure to list them.

Sub ListHotKeys(uf As UserForm)
   
    Dim ctl As Control
    Dim aKeys() As String
    Dim sKey As String
    Dim i As Long, j As Long
   
    For Each ctl In uf.Controls
        sKey = ""
       
        'Not all controls have this property
        On Error Resume Next
            sKey = ctl.Accelerator
        On Error GoTo 0
       
        If Len(sKey)> 0 Then
            i = i + 1
            ReDim Preserve aKeys(1 To i)
            aKeys(i) = sKey
        End If
    Next ctl
   
    For i = LBound(aKeys) To UBound(aKeys) - 1
        For j = i + 1 To UBound(aKeys)
            If aKeys(i)> aKeys(j) Then
                sKey = aKeys(i)
                aKeys(i) = aKeys(j)
                aKeys(j) = sKey
               
            End If
        Next j
    Next i
   
    For i = 1 To UBound(aKeys)
        Debug.Print aKeys(i)
    Next i
       
End Sub

FillSeries Keyboard Shortcut

I have never found a decent keyboard shortcut for filling a series, despite being the self-anointed king of all things keyboard. Oh sure, I could Alt+E, I, S, Enter, but it's just not satisfying. So in the vein of selecting adjacent columns, I added a macro to my Personal.xls.

Sub FillSeries()
   
    Dim lFirstBlank As Long
   
    If TypeName(Selection) = "Range" Then
        If Selection.Columns.Count = 1 Or Selection.Rows.Count = 1 Then
            lFirstBlank = GetFirstBlank(Selection)
            If lFirstBlank> 1 Then
                If Selection.Columns.Count = 1 Then
                    Selection.Cells(1).Resize(lFirstBlank - 1).AutoFill _
                        Selection, xlFillSeries
                ElseIf Selection.Rows.Count = 1 Then
                    Selection.Cells(1).Resize(, lFirstBlank - 1).AutoFill _
                        Selection, xlFillSeries
                End If
            End If
        End If
    End If
   
End Sub
 
Function GetFirstBlank(rRng As Range) As Long
   
    Dim i As Long
   
    i = 0
   
    For i = 1 To rRng.Cells.Count
        If IsEmpty(rRng.Cells(i)) Then
            GetFirstBlank = i
            Exit For
        End If
    Next i
   
End Function

It makes some assumptions that you don't have to make when you use the mouse. Everything above the first empty cell defines the series and the entire selection is the destination. Here are some examples where I select 10 rows:

Before:

After:

The first column is pretty straight forward. In the second column, the 12 is blown away because it's below the first empty cell. In the third column, the first cell is empty so nothing happens. In the last column, there are no empty cells, so nothing happens.

Finally, I updated my Auto_Open/Close procedures to assign a shortcut key.

Sub Auto_Open()
   
    Application.OnKey "^%{DOWN}", "SelectAdjacentCol"
    Application.OnKey "^%{RIGHT}", "FillSeries"
   
End Sub
 
Sub Auto_Close()
   
    Application.OnKey "^%{DOWN}"
    Application.OnKey "^%{RIGHT}"
   
End Sub