Book1.Saved = True

Book1.Saved = True

You may be familiar with VBA’s Workbook.Saved property. It’s read/write and lets you determine, or set, whether a workbook has been saved. Reading is straightforward but setting is more interesting. Declaring MyBook.Saved = True doesn’t actually save the workbook, it just tells Excel to act like it’s saved. So, if you don’t make any changes to the workbook and you go to close it, you won’t be prompted to save.


If you had asked me if it’s possible to set the Saved property on a never-been-saved workbook I would have said, “I don’t know, let me try it and get back to you.” Well you didn’t ask, but I’m getting back to you anyways. It turns out you can. You can open up a brand-new workbook, type “Movin’ to Montana soon” in A1 and “Gonna be a dental floss tycoon” in A2, then enter Book1.Saved in the immediate window, and you won’t be prompted to save if you close it.

I didn’t expect that. It kind of makes sense that you can declare an existing workbook to be saved, but one that doesn’t even have a location yet? That doesn’t sit right with the left side of my brain, which would prefer that the property be re-named to something like Workbook.YouWontBePromptedToSaveUnlessYouChangeSomething.

To expand on the above paragraph, a never-been-saved workbook doesn’t have a path. You can test the ActiveWorkbook with ActiveWorkbook.Path = "", which returns True if the workbook has never been saved. I’d thought maybe setting Saved to True would change the Path property to the never-been-saved workbook location, but it doesn’t. Also, if you do decide to save, the Save As menu pops up, just as you’d hope. So it looks like setting Saved to True changes nothing except that you won’t be prompted to save.

I’ve found this useful for a certain kind of utility: one that prints out information which I want to examine but not keep. For instance, there’s a routine I use a lot that compares the sheets in two workbooks. It opens a new workbook and prints information about all the sheets in each book and whether they occur in the other book and, if so, the extent to which they match. The new workbook with the comparison is called “wbComparison,” so the last line of code is:

wbComparison.Saved = True

I know it’s a small thing, but it pleases me to look over the comparison and close it without being prompted to save.

Here’s a very simple sample for your testing pleasure:

Sub ShowZappaLyrics()
Dim wbZappa As Excel.Workbook

Set wbZappa = Workbooks.Add
With wbZappa
    With .Worksheets(1)
        .Cells(1, 1) = "Movin' to Montana soon"
        .Cells(2, 1) = "Gonna be a Dental Floss tycoon"
    End With
    .Saved = True
End With
End Sub

Camera Tool Selfie

Camera Tool Selfie

Happy New Year!

This post-holiday post harkens back thematically to Pivot Table Circular References, while utilizing some of what we learned in Conditional Formatting Color Scales Based on Other Cells.

But enough self-referential posturing, let’s have some tautological photo fun!

I was reading Debra’s roundup the other day and somebody was talking about… actually, it doesn’t matter what, but it got me wondering what would happen if you used the camera tool to take a picture of itself. In case you were wondering, this is the “thematic harkening” to the first linked post above, in which I tried to base a pivot table on itself. This time the results were more colorful, if no more useful.

So what you see below is a dynamic picture taken with the camera tool of an area conditionally formatted with a color scale and the number format set to “;;;”. See the second link above for explanations of all that.

Add a little VBA automation and you can get rid of your cable subscription.

What I didn’t see coming was the infinite loopiness, where the camera tool takes a pic of itself taking a pic of itself taking a pic … Pretty cool.

camera tool selfie

Kind of like when you’re in a dressing room with the mirrors front and back and you get a reflection of a reflection of a reflection … Unless you’re like me and you just keep buying the same pants online.

Here’s the downloadable workbook. See you next time around!

Get UNC Filenames

Get UNC Filenames

If you work on a network with mapped servers or drives you may sometimes need a full UNC filename in it’s unmapped state. For example, computers in different departments may refer to the same location by different mappings. Say you work in the Pastry Procurement department and your computer refers to \\AcmeServer0023\Top_Secret_Pie_Recipes as T:\Top_Secret_Pie_Recipes, but your co-worker in Puddings and Pecan Puffs sees it as P:\Top_Secret_Pie_Recipes. If you send them a link using your mapping of “T:\” it won’t work for them. This post solves that problem by converting the mapped path – the one that starts with “T:\” – to its UNC equivalent – the one that starts with “\\AcmeServer0023.”

There are some fine methods out there for doing part of this conversion using VBA such as this comment by Emily at Daily Dose of Excel. That post also includes a method Dick discovered using the generally-reviled Web toolbar (I used to have a macro whose sole function was to hide that useless thing whenever it popped back up) but it only works for open workbooks.

This post incorporates existing Office functionality whereby links created with mapped drives actually show the UNC drive when you edit them. Here I’ve opened the Add Hyperlink dialog and selected a file. Note that the Address box at the bottom shows the mapped filename:

Hyperlink dialog

After closing the dialog and then opening the Edit Hyperlink dialog the Address box shows the UNC filename:

Edit hyperlink dialog

I like this method because it gives you the whole shebang and it works for all file types, not just Excel workbooks. Of course, it’s boring to generate more than a couple, so I wrote some VBA to automate the process. That way I can point to one or more files and paste their UNC monikers wherever I want.

This is a fairly trivial task and I’d rather not wipe out Excel’s Undo stack with the VBA. Since this hyperlink trick works just as well in Word, I thought I’d do it in a quickly opened, used, and then closed, instance of Word.

(You could modify this to open another Excel instance and use that, since you won’t lose the Undo stack across instances. You could also check if Word is already open and use that instance. I used Word because, since I don’t have addins in it, I think it opens faster. I don’t bother checking for an open instance because the whole thing only takes a couple of seconds as is.)

The code is pretty straightforward. It uses late binding for the Word objects, so that it doesn’t care what version of Word you’re using (and so that JP won’t give me grief if he’s still reading this blog). It also uses a Windows DataObject to hold the filenames and copy them to the clipboard.

Sub Browse_To_File_and_Copy_UNC_Names_to_Clipboard()
Dim fdFileDialog As FileDialog
Dim FileName As String
Dim FileNames As String
Dim doFileNames As DataObject
Dim SelectedItemsCount As Long
Dim wrdApp As Object
Dim wrdDoc As Object
Dim TempLink As Object
Dim i As Long

Set fdFileDialog = Application.FileDialog(msoFileDialogOpen)
With fdFileDialog
    .ButtonName = "Select"
    .FilterIndex = 1
    .InitialView = msoFileDialogViewDetails
    .Title = "Select Files"
    .ButtonName = "Select"
    .AllowMultiSelect = True
    If .SelectedItems.Count = 0 Then
        GoTo Exit_Point
    End If
    Set doFileNames = New DataObject
    SelectedItemsCount = .SelectedItems.Count
    Set wrdApp = CreateObject("Word.Application")
    Set wrdDoc = wrdApp.Documents.Add
    For i = 1 To SelectedItemsCount
        Set TempLink = wrdDoc.Hyperlinks.Add(Anchor:=wrdApp.Selection.Range, Address:=.SelectedItems(i))
        FileName = TempLink.Address
        FileNames = FileNames & FileName & vbCrLf
    Next i
    FileNames = Left(FileNames, Len(FileNames) - 1)
    doFileNames.SetText FileNames
End With

On Error Resume Next
wrdDoc.Close False
End Sub

When you run the code this dialog pops up. You can select one or more files:

File browser

After you’ve selected them, they’ll be in the Windows clipboard and you can paste them wherever you want, like into an email.

Pasted UNCs

Importing SQL Files Into Data Connections

Importing SQL Files Into Data Connections

By now you may know that I love data connections in Excel. Sometimes I use them for the front-ends in finished projects, but mostly I use them for testing SQL. With its formulas, tables and pivot tables, Excel makes a great test environment for validating SQL results. You can of course just paste query output straight from SQL Server Management Studio or other development environments, but the it doesn’t always format correctly. For instance Varchar ID fields that are all numbers lose leading zeros and dates lose their formats. In my experience those problems don’t happen with data connections

In this post, we’ll start with the basics of a reusable Table/SQL connection to which you can then add your SQL. Then I’ll share some code that lets you point at one or more .sql files and creates a connected table for each one. (An .sql file is just a text file with SQL in it and an .sql extension for handy identification.)

A Reusable Table/SQL Connection

At work I have a default data connection to the main database we query, all set up with the Connection, Command Type and some dummy Command Text. Whenever I want to run some SQL against that database in Excel, I just click on that connection in Data > Existing Connections. If I worked at home and used SQL Server and kept the corporate database on my laptop, the connection could look like this.

SQL Server template connection

I created it by going to Data > Connections > Other Sources > From SQL Server. After following the wizard, I modified the connection by changing the Command Type to SQL and the Command Text to the meaningless, but super-speedy query “SELECT ‘TEMP’ FROM TEMP.”

So now I’ve got a template I can call from Data > Existing Connections and quickly modify the SQL, say to something like:

SQL Server template connection 2

Inserting SQL Directly From .sql Files

Recently I thought I’d take this a bit further and pull the CommandText directly from an .sql file. So I wrote some code that has you pick one or more .sql files, and then creates a new Worksheet/Table/Query for each one in a new workbook. The main query is below. The heart of it looks a lot like what you got if you ran the macro recorder while creating a new connection:

Sub AddConnectedTables()
Dim wbActive As Excel.Workbook
Dim WorksheetsToDelete As Collection
Dim ws As Excel.Worksheet
Dim qt As Excel.QueryTable
Dim sqlFiles() As String
Dim ConnectionIndex As Long

sqlFiles = PickSqlFiles
If IsArrayEmpty(sqlFiles) Then
    Exit Sub
End If

Set wbActive = ActiveWorkbook
'Identify the empty sheet(s) the workbook has on creation, for later deletion
Set WorksheetsToDelete = New Collection
For Each ws In wbActive.Worksheets
    WorksheetsToDelete.Add ws
Next ws

For ConnectionIndex = LBound(sqlFiles) To UBound(sqlFiles)
    wbActive.Worksheets.Add after:=ActiveSheet
    '*** Modify the location below to match your computer ***
   Set qt = ActiveSheet.ListObjects.Add(SourceType:=0, _
        Source:="ODBC;DSN=Excel Files;DBQ=E:\DOCS\YOURSUMBUDDY\BLOG\POST_72_SQL_IMPORTER\Post72_Data.xlsx;DriverId=1046;MaxBufferSize=2048;PageTimeout=5;", _
    With qt
        'Temporary command text makes the formatting for the real query work
       .CommandText = ("SELECT 'TEMP' AS TEMP")
        .ListObject.DisplayName = "tbl" & Format(Now(), "yyyyMMddhhmmss") & "_" & ConnectionIndex
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        'Refresh first with just the template query
       .Refresh BackgroundQuery:=False
        .CommandText = ReadSqlFile(sqlFiles(ConnectionIndex))
        'Refresh again with the new SQL. Doing this in two steps makes the formatting work.
       .Refresh BackgroundQuery:=False
        .AdjustColumnWidth = False
        'Name the just-created connection and table
       .ListObject.DisplayName = Replace("tbl" & Mid$(sqlFiles(ConnectionIndex), InStrRev(sqlFiles(ConnectionIndex), Application.PathSeparator) + 1, 99) & Format(Now(), "yyyyMMddhhmmss") & "_" & ConnectionIndex, ".sql", "")
        wbActive.Connections(1).Name = .ListObject.DisplayName
    End With
Next ConnectionIndex

'Delete the empty sheet(s) the worbook had on creation
Application.DisplayAlerts = False
For Each ws In WorksheetsToDelete
Next ws
Application.DisplayAlerts = True
End Sub

Notice that the code refreshes the querytable twice. If I just go straight to the query from the .sql file, I end up with the same type of formatting problem described at the beginning of this post. For example, dates come through without formatting, like 41985. Starting with a dummy query of SELECT ‘TEMP’ AS TEMP, refreshing it, setting the .CommandText to the correct SQL and refreshing again results in correct formatting.

The code also sets .AdjustColumnWidth twice because I like to start with correct column widths and then not have them adjust after that.

You’ll also note that the connection in the code above isn’t to a SQL Server database anymore, but to an Excel workbook. That’s because I created a downloadable folder for you to try this out in, and the easiest data source to include is an Excel workbook. See the end of this post for the link and a few instructions.

(Also as a weird bonus in the code above is something I came up with to delete the one or more vestigial empty worksheets that get created in a situation like this where your creating a new workbook in code.)

Below are the three functions called from the module above. One uses a File Dialog to pick one or more .sql files.

Private Function PickSqlFiles() As String()
Dim fdFileDialog As FileDialog
Dim SelectedItemsCount As Long
Dim sqlFiles() As String
Dim i As Long

Set fdFileDialog = Application.FileDialog(msoFileDialogOpen)
With fdFileDialog
    .ButtonName = "Select"
    .Filters.Add "SQL Files (*.sql)", "*.sql"
    .FilterIndex = 1
    .InitialView = msoFileDialogViewDetails
    .Title = "Select SQL Files"
    .ButtonName = "Select"
    .AllowMultiSelect = True
    If .SelectedItems.Count = 0 Then
        GoTo Exit_Point
    End If
    SelectedItemsCount = .SelectedItems.Count
    ReDim sqlFiles(1 To SelectedItemsCount)
    For i = 1 To SelectedItemsCount
        sqlFiles(i) = .SelectedItems(i)
    Next i
End With
PickSqlFiles = sqlFiles

End Function

This one returns the SQL from the .sql file, so that it can then be stuffed into the QueryTable’s .CommandText property:

Private Function ReadSqlFile(SqlFileFullName As String)
Dim SqlFileLine As String
Dim Sql As String

Open SqlFileFullName For Input As #1
Do Until EOF(1)
    Line Input #1, SqlFileLine
    Sql = Sql & SqlFileLine & vbNewLine
'Sql = Input$ '(LOF(#1), #1)
Close #1
ReadSqlFile = Sql
End Function

And this is Chip Pearson’s code for checking if an array, specifically that returned by the PickSqlFiles function, is empty:

Public Function IsArrayEmpty(Arr As Variant) As Boolean
'Chip Pearson
Dim LB As Long
Dim UB As Long

On Error Resume Next
If IsArray(Arr) = False Then
    ' we weren't passed an array, return True
   IsArrayEmpty = True
End If
UB = UBound(Arr, 1)
If (Err.Number <> 0) Then
    IsArrayEmpty = True
    LB = LBound(Arr)
    If LB > UB Then
        IsArrayEmpty = True
        IsArrayEmpty = False
    End If
End If
End Function

Download and Instructions

This download marks a new level of complexity, so it’s got instructions.

After you download you’ll need to unzip the folder to wherever you want. It contains five files, the xlsm with the code, the workbook data source and three .sql files with queries against that data source:

Unzipped folder

There’s further instructions in the xlam file. As noted there, you’ll need to change the path in the VBA to your unzipped folder (technically, you don’t because Excel will prompt you when it can’t find the folder in the VBA, but it will be cooler if you do). There’s a handy Cell formula in the Post72_Import_SQL.xlsm which will give you the correct file path.

Here’s the downloadable folder. Let me know what you think!

Undo Selections With SelecTracker!

Undo Selections With SelecTracker!

On one of the DDOE posts about International Keyboard Shortcut Day, a commenter known only as VvM asked for ways to undo selections in Excel. You know how it goes. You’ve selected various parts of a huge table to turn them bold or purple or something and you grab one more cell than you wanted. Wouldn’t it be great if you could just unselect it by clicking again, the way you can in just about any other #$;@#%! situation you can imagine. So, you keep clicking and it kind of looks like it worked because the active cell is a different color than the rest of the selection, but no. You’re doomed! You’ve got to start over from scratch. Aargh!

Anyways, the answer is there’s no way to undo selections in the Excel interface proper. You need VBA. And VBA is what you get in the handy form of my newest utility, SelecTracker.

Imagine you’re entered in a contest where you only have to click three cells with high dollar amounts to walk away with fistfuls of cash. Once you start you can’t start over, but you are allowed to use free utilities with goofy names that you downloaded from Excel websites (also with goofy names). In that case SelecTracker could really save your bacon:

That’s right. Just uncheck the offending selection(s) in the handy list and it’s like it never happened.

Top three gifts

Other lovely SelecTracker features:

– Start it after your selections are made and you realize you need to unselect
– Doesn’t affect Excel’s Undo stack
– Gives you a better understanding of how Excel selections work

Weird Things I Learned About Selecting in Excel

Try this:

Hold down the Ctrl key and click A1 five times.

Now, in the Immediate window type:
? Selection.Areas.Count and hit Enter

Now enter:
? Selection.Address

immediate window #1

So, all those times you tried to unselect by clicking again, you were really just selecting it even more. If only you’d had SelecTracker back then:

A1 many times

If you hold down the Ctrl key and click in cells A1 to A5 one at a time, you’ll get similar, slightly less weird, results. And if you do it and then start up SelecTracker (or vice-versa), you’ll see a different representation of the same results:


So, each selection (with a small “s”) in a Selection is a VBA Area. On the linked MSDN page the Areas definition reads:

The Areas collection contains one Range object for each discrete, contiguous range of cells within the selection.

But clearly that’s within the VBA world where Range("A1:A5") has one Area. But within a Selection (with a capital “S”) it has one Area for each selection you make while holding down the Ctrl key. “Contiguous” doesn’t really enter into it.

This makes the VBA pretty simple. To populate the form’s listbox, I just cycle through the Selection’s Areas and add each one:

With Me.lstSelections
    For Each SelArea In Selection.Areas
        .AddItem SelArea.Address
        .Selected(.ListCount - 1) = True
    Next SelArea
End With

And to re-select the areas when a listbox item is checked or unchecked:

With Me.lstSelections
    For i = 0 To .ListCount - 1
        If .Selected(i) Then
            NewSelection = NewSelection & .List(i) & ","
        End If
    Next i
    NewSelection = Left(NewSelection, Len(NewSelection) - 1)
End With

I thought I’d do the above by Unioning the various Areas represented in the listbox. But once you Union them they’re not Areas any more. At least not if there contiguous. So instead I glued the text from the list items together.

(I don’t think other countries use other delimiters than commas, but can’t remember for sure and had no luck searching for it. Please tell me if you know otherwise.)

The rest of the code uses some concepts from UserForm Application-Level Events, Chip Pearson’s code for making forms resizable, and other neat stuff.

Download it and see for yourself.

Thanks VvM, whoever you are!

Happy International Keyboard Shortcut Day

Happy International Keyboard Shortcut Day

Over at DDOE Dick has decreed the first Wednesday of November as International Keyboard Shortcut Day. In a comment to his post I said I’m about 50-50 in my mouse-to-shortcut ratio.

A literal case in point is my use of Alt-F11, which VBA folk will recognize as the key combo that whisks you from Excel to the Visual Basic Editor. I use it all the time. Oddly, I rarely use it in the other direction.

Speaking of the VBE… it still has old-style toolbar menus, the kind you can easily modify. Whenever I get a new computer there’s a few VBE setup things I always do, like install M-Z Tools and Smart Indenter. I also get rid of many of the buttons, like Cut, Copy and Paste. Ctrl-X, Ctrl-C and Ctrl-V were among the first shortcuts I used regularly and it still gives me a sense of competence and tidiness to trash them.

Speaking of the VBE… some of my favorite shortcuts these days are those that combine the Windows key and arrows for moving windows around on your monitor(s). I use them a lot on my laptop, usually to push the VBE to the right and Excel to the left.

Extreme Keyboard Shortcuts

Poking around for pictures to pad this post, one caught my eye with its double meaning:

keyboard shortcuts 1

This one is just whacky. I’ve read the explanation, but I still don’t know what it does. I think the creator may be as fanatical as Dick:

keyboard shortcuts 1

Flexible Chooser Form With Apply Button

Flexible Chooser Form With Apply Button

“Apply” buttons in forms can be confusing. People sometimes think they have to hit Apply before they hit OK But OK really means “make the change and close,” while Apply means “make the change but don’t close.” Also, a Cancel button on a form with an Apply button doesn’t actually cancel actions that were applied, just those since the last apply. At least that’s the way it works in many Windows dialogs, like Windows Explorer’s:

win explorer apply cancel

Excel’s Conditional Formatting dialog adds an extra wrinkle. Below I’ve modified a rule to change the color for orange for macaroons. I haven’t hit Apply yet, so I could choose:

1. Apply to save the change and keep on working
2. OK to save the changes and exit
3. Cancel to exit without saving

CF Apply button 1

Once I hit Apply, the Cancel button changes to a Close button. At this point OK and Close mean the same thing: close the form. It seems like Close is just a placeholder for the Cancel button, which will reappear once I start to change something. It is nice that Close and Cancel actually mean what I’d expect with this dialog.

CF Apply button 2

A less confusing form might be one with just an Apply and a Close button. It’s really all you need, and the only downside haveing to click Apply and then Close instead of OK. I did this on one of my own utility forms, but in general I’ll keep using OK buttons because that’s the norm.

Adding an Apply Button to My Flexible Chooser Form

Back in A Flexible VBA Chooser Form I showed how to create a simple form to which you pass some values and which returns a choice. The example let the user pick from a list of pivot fields and then highlighted the field’s range and showsed some information about it. For this post, I modified that code to add an “Apply” button, so you can stay in the form and show info for different fields as long as you want.

Much of the form’s code is unchanged from the earlier post, so read it if you want more background. Its “ClosedWithOk” property is now a more flexible FormState one that stores whether the Apply, OK or Close button was clicked. The code that calls the form is also mostly similar, with a Do While loop added to manage the Apply button. Here it is:

Sub ShowPivotFieldInfo()

Dim pvt As Excel.PivotTable
Dim lo As Excel.ListObject
Dim StartingCell As Excel.Range
Dim i As Long
Dim FormState As String
Dim DoneWithForm As Boolean
Dim PivotFieldNames() As String
Dim pvtField As Excel.PivotField
Dim ChosenName As String

Set pvt = ActiveSheet.PivotTables("pvtRecordTemps")
Set lo = ActiveSheet.ListObjects("tblRecordTemps")
Set StartingCell = ActiveCell
With pvt
    ReDim PivotFieldNames(1 To .VisibleFields.Count) As String
    For i = 1 To .VisibleFields.Count
        PivotFieldNames(i) = .VisibleFields(i).Name
    Next i
    DoneWithForm = False
    Do While Not DoneWithForm
        ChosenName = GetChoiceFromChooserForm(PivotFieldNames, "Choose a Pivot Field", FormState)
        DoneWithForm = (FormState <> "Apply")
        If ChosenName = vbNullString Then
            GoTo Exit_Point
        End If
        Set pvtField = .PivotFields(ChosenName)
        With pvtField
            Union(.DataRange, lo.ListColumns(.SourceName).DataBodyRange).Select
            MsgBox Title:=.SourceName, _
                   Prompt:="The SourceName for " & ChosenName & " is:" & vbCrLf & vbCrLf & .SourceName
        End With
End With

End Sub

I had to add a ByRef variable, “FormState,” to the function that initializes and gets the choice from the userform. That’s because, in addition to returning the choice, this function now returns whether the OK, Apply or Close button was clicked:

Function GetChoiceFromChooserForm(strChoices() As String, strCaption As String, ByRef FormState As String) As String
Dim ufChooser As frmChooser
Dim strChoicesToPass() As String

ReDim strChoicesToPass(LBound(strChoices) To UBound(strChoices))
strChoicesToPass() = strChoices()
Set ufChooser = New frmChooser
With ufChooser
    .Caption = strCaption
    .ChoiceList = strChoicesToPass
    FormState = .FormState
    If Not FormState = "Close" Then
        GetChoiceFromChooserForm = .ChoiceValue
    End If
End With
End Function

Pivot field lister with apply


I’m glad you asked. Here it is.

UserForm Event Class – Number Selector

UserForm Event Class – Number Selector

In my world, when a form has a spinbutton, it’s got a textbox. Together they make a little thing I like to call a Number Selector. This handy control lets you pick digits by clicking the spinbutton, typing in the textbox, and even using the up and down keys. Whichever you do, the code keeps the textbox and spinbutton in sync. If you try to type anything non-numeric in the textbox it’s ignored. If you type a number outside the Min or Max of the spinbutton, it reverts to the minimum or the maximum. I find this all quite cool, and fun to code.

A Basic Number Selector

There’s lots of ways to combine a spinbutton and textbox into a number selector. Here’s a basic version of how I code it:

Private wsActive As Excel.Worksheet

Private Sub UserForm_Activate()
Set wsActive = ActiveSheet
Me.spnRowNum.Min = 1
Me.spnRowNum.Max = wsActive.Rows.Count
End Sub

Private Sub spnRowNum_Change()
Me.txtRowNum.Value = Me.spnRowNum.Value
End Sub

Private Sub txtRowNum_Change()
If IsNumeric(Me.txtRowNum.Value) Then
    If Me.txtRowNum.Value < Me.spnRowNum.Min Then
        Me.txtRowNum.Value = Me.spnRowNum.Min
    ElseIf Me.txtRowNum.Value > Me.spnRowNum.Max Then
        Me.txtRowNum.Value = Me.spnRowNum.Max
    End If
    Me.spnRowNum = Me.txtRowNum.Value
    Me.txtRowNum.Value = Me.spnRowNum.Value
End If
End Sub

Spinning the button or typing in the textbox selects a row between 1 and the sheet’s last row:

basic number selector

A Number Selector Class

Continuing the recent theme of of userform control classes, this post is about a number selector class. “Classifying” the control (sorry) eliminates a ton of duplicated code in your form, similar to what was done in the UserForm Event Handler Class – Multiple Controls post.

Besides the basic features discussed above, my number selector has:

  • Accelerator keys. Clicking the Shift, Ctrl and Alt keys increases the spinbutton’s SmallChange property. The accelators are cumulative and don’t care which of these keys were pressed, just how many. For example, if you set accelerators of 2, 3 and 5 and press Shift and Ctrl (or Alt and Ctrl), the increment is increased by a factor of six.
  • A Change event. You capture this event in the calling form, just like you would for Worksheet_Change and other built-in events. One limitation is these only fire for the first class instance in an array or collection of instances. Depending on what you’re doing that might not matter anyways, like in the form below.

Here’s the code for the class. Hopefully the comments get at the tricky stuff. I’ll say more about it below:

Private WithEvents spnSelector As MSForms.SpinButton
Private WithEvents txtSelector As MSForms.TextBox
Private m_Value As Long
Private m_Min As Long
Private m_Max As Long
Private m_Increment As Long
Private m_CurrentIncrement As Long
Private m_Accelerators(1 To 3) As Long
Private m_Executed As Boolean

'call this event in your userform
Event NumberSelectorChanged()

Public Sub Execute()
'call this code when all properties are set
If spnSelector Is Nothing Or txtSelector Is Nothing Then
    Err.Raise 9998, , _
    "Set the Group before other properties" & _
    "and confirm that it contains a TextBox and and SpinButton"
End If
spnSelector.SmallChange = m_Increment
spnSelector.Min = m_Min
spnSelector.Max = m_Max
If m_Value < m_Min Or m_Value > m_Max Then
    m_Value = m_Min
End If
spnSelector.Value = m_Value
txtSelector.Value = m_Value
m_Executed = True
End Sub

Public Property Let Group(grp As MSForms.Frame)
'Note: this property must be set first
'It gets the frame on the UserForm that contains the spinbutton and textbox
Dim ctl As MSForms.Control

For Each ctl In grp.Controls
    If TypeOf ctl Is MSForms.SpinButton Then
        Set spnSelector = ctl
    ElseIf TypeOf ctl Is MSForms.TextBox Then
        Set txtSelector = ctl
    End If
Next ctl
End Property

Public Property Let Value(PassedValue As Long)
m_Value = PassedValue
'don't want to reference controls until Execute sub run
'or you'll get a runtime error
If m_Executed Then
    RaiseEvent NumberSelectorChanged
    spnSelector.Value = m_Value
    txtSelector.Value = m_Value
End If
End Property

Public Property Get Value() As Long
Value = m_Value
End Property

Public Property Let Min(PassedMin As Long)
m_Min = PassedMin
End Property

Public Property Let Max(PassedMax As Long)
m_Max = PassedMax
End Property

Public Property Let Increment(Optional acc1 As Long = 1, Optional acc2 As Long = 1, Optional acc3 As Long = 1, PassedIncrement As Long)
'properties can have parameters, so this property includes the accelators,
'along with the Increment (SmallChange).
'PassedIncrement is the only required one
m_Increment = PassedIncrement
m_CurrentIncrement = m_Increment
m_Accelerators(1) = acc1
m_Accelerators(2) = acc2
m_Accelerators(3) = acc3
End Property

'Acc1, etc., included to match the Let definition, otherwise won't compile
Property Get Increment(Optional acc1 As Long = 1, Optional acc2 As Long = 1, Optional acc3 As Long = 1) As Long
Increment = m_CurrentIncrement
End Property

Private Sub spnSelector_Change()
Me.Value = spnSelector.Value
End Sub

Private Sub txtselector_Change()
With txtSelector
    Select Case .Value
    'Allow a single negative sign or an empty string,
   'but no processing required
   Case "-", ""
        Exit Sub
    End Select
    'whole numbers only
   If IsNumeric(.Value) And InStr(.Value, ".") = 0 Then
        If .Value < m_Min Then
            .Value = m_Min
        ElseIf .Value > m_Max Then
            .Value = m_Max
        End If
        Me.Value = CStr(.Value)
        .Value = m_Value
    End If
End With
Me.Value = txtSelector.Value
End Sub

'The next four routines capture accelerators (Shift, Ctrl, Alt)
'if pressed while textbox or spinbutton is active

Private Sub spnSelector_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
SetCurrentIncrement Shift
End Sub

Private Sub spnSelector_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
SetCurrentIncrement Shift
End Sub

Private Sub txtSelector_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = vbKeyDown Then
    KeyCode = vbNull
    txtSelector.Value = txtSelector.Value - m_CurrentIncrement
ElseIf KeyCode = vbKeyUp Then
    KeyCode = vbNull
    txtSelector.Value = txtSelector.Value + m_CurrentIncrement
End If
SetCurrentIncrement Shift
End Sub

Private Sub txtSelector_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
SetCurrentIncrement Shift
End Sub

Private Sub SetCurrentIncrement(ByVal ShiftMask As Integer)
'Uses bitwise AND's against the Shift enum to determine if the
'Shift, Ctrl or Alt keys were pressed, and
'multiplies the m_Increment by the corresponding accelerator
'accelerators are cumulative

Dim IncrementLevel As Long
IncrementLevel = _
(((ShiftMask And 1) = 1) * -1) + _
                 (((ShiftMask And 2) = 2) * -1) + _
                 (((ShiftMask And 4) = 4) * -1)

m_CurrentIncrement = m_Increment * _
                     IIf(IncrementLevel >= 1, m_Accelerators(1), 1) * _
                     IIf(IncrementLevel >= 2, m_Accelerators(2), 1) * _
                     IIf(IncrementLevel >= 3, m_Accelerators(3), 1)
spnSelector.SmallChange = m_CurrentIncrement
End Sub

Because this class has quite a few properties, the logic for the order in which they must be assigned is a bit clunky. For instance, if you try to assign the Value, Min or Max before you’ve passed the controls to the class, it won’t work. So I created an Execute method – a Sub within the query – that assigns the values from the class-level private variables to the spinbutton and textbox.

There’s also some Err.Raise code try to deal with bad initialization. But I don’t try to handle form-specific issues – I want it to be portable – so if you assign a min of zero and use it to pick row numbers, you’ll get a runtime error.

As mentioned in the comments, the Increment property has three accelerator parameters. I’d never used parameters with a property before. You have to list the “real” one last, and the preceding ones can be optional. If you have a matching Get property, it must include the same parameters, or you’ll get a compile error.

I also added some KeyDown logic for the textbox part of the control. Normally, if you’re in a textbox the down arrow takes you to the next control. I wanted it to act the same as the up and down keys do when the spinbutton is active, so I cancel the KeyDown event if the down or up arrows are pressed, and instead add or subtract the correct amount to the value in the textbox.

A Form With Three Class Instances

The UserForm for this utilization of the class has three number selectors. The first selects rows, the next selects columns. The third increments the seconds from midnight last night. Each number selector is framed by a … frame. They’re named grpRowSelector, grpColSelector and grpSecondsFromNow respectively (I think of them as Groups, hence the “grp”). It doesn’t matter what the spinbutton and textbox are called, as the class just checks for those controls inside the frame, which is passed to the class in UserForm_Activate.

You can see what I mean about simple code in the form. There’s just the initialization of the classes and the Change event for each one> Note that the this number selector has accelerators of 60, 60 and 24, so you can increment by seconds, minutes, hours or days:

Private WithEvents cRowSelector As clsNumberSelector
Private WithEvents cColumnSelector As clsNumberSelector
Private WithEvents cSecondsFromNow As clsNumberSelector

Private Sub UserForm_Activate()
Dim MaxSeconds As Long

Set cRowSelector = New clsNumberSelector
With cRowSelector
.Group = Me.grpRowSelector
.Min = 1
.Max = ActiveSheet.Rows.Count
.Value = 1
‘properties can have parameters
.Increment(acc1:=5, acc2:=10, acc3:=100) = 1
‘Needed to confirm that properties entered correctly
End With

‘see comments for class instance above
Set cColumnSelector = New clsNumberSelector
With cColumnSelector
.Group = Me.grpColumnSelector
.Min = 1
.Max = ActiveSheet.Columns.Count
.Value = 1
.Increment(2, 5, 10) = 1
End With

‘see comments for class instance above
Set cSecondsFromNow = New clsNumberSelector
With cSecondsFromNow
MaxSeconds = (10# * 24 * 60 * 60) ‘# to make it a Long
.Group = Me.grpSecondsFromNow
.Min = -MaxSeconds
.Max = MaxSeconds
.Value = 0
.Increment(60, 60, 24) = 1
End With
End Sub

‘custom events raised in clsNumberSelector
Private Sub cRowSelector_NumberSelectorChanged()
Me.txtIncrementValue = cRowSelector.Increment
End Sub

Private Sub cColumnSelector_NumberSelectorChanged()
Me.txtIncrementValue = cColumnSelector.Increment
End Sub

Private Sub cSecondsFromNow_NumberSelectorChanged()
Me.txtDateAndTime.Value = Format(Date + cSecondsFromNow.Value / (24# * 60 * 60), “yyyy-mm-dd hh:mm:ss”)
Me.txtIncrementValue = cSecondsFromNow.Increment
End Sub

userform with three number selectors


What you’d like to try this code, but don’t feel like copying and pasting and dragging controls around? I understand. Check this out.

P.S. If you want to read a great post about class properties, you can do no better than this one by Tushar Mehta on DDOE.

UserForm Event Class – Validating Controls

UserForm Event Class – Validating Controls

At the end of my last post I said I’d be back with an actual use for a multiple-control event class. And here I am! It seems to me that validating controls in a userform is a very good use for this type of class. Not having the validation mixed in could really unclutter the main form and clarify things. So let’s look at a real-life application that I’ve just updated to this kind of control validation. It’s probably full of bugs, but what the heck.

The application is an addin for splitting worksheets into separate workbooks based on one or two columns. The process starts with a form where users choose the row with the headers and the column(s) to split on. The userform opens with the active row selected and the OK button disabled. When users select a primary column the OK button is activated. If they clear the row textbox, pick a secondary column without a primary column, or pick the same column for both, the OK button is disabled and an error message shows. This functionality is all handled in a multiple-control WithEvents class:

three validation messages

As you can see, there’s a textbox at the bottom to display the validation error message. In all three cases, in addition to showing the message, the OK button is disabled. My hope is that this provides a user-friendly experience: guiding them and letting them try different things without wasting their time pushing “OK” when it’s really not.

The class with the validation looks a lot like the multiple-control class from the last post. Just like there, every control’s click or change event calls the same procedure. In this case it’s a validation procedure, called “CheckReadyState.” It runs a few tests to make sure the various controls are in harmony. If so, the form’s “OK” button is enabled. If not, it’s disabled and a validation error message is shown. Here’s the whole class:

Private WithEvents txt As MSForms.TextBox
Private WithEvents lst As MSForms.ListBox
Private WithEvents chk As MSForms.CheckBox
Private WithEvents spn As MSForms.SpinButton
Private m_PassedControl As MSForms.Control
Private m_ParentForm As MSForms.UserForm

Property Set ctl(PassedControl As MSForms.Control)
Set m_PassedControl = PassedControl
Select Case True
Case TypeOf PassedControl Is MSForms.TextBox
    Set txt = PassedControl
Case TypeOf PassedControl Is MSForms.ListBox
    Set lst = PassedControl
Case TypeOf PassedControl Is MSForms.CheckBox
    Set chk = PassedControl
Case TypeOf PassedControl Is MSForms.SpinButton
    Set spn = PassedControl
End Select

Set m_ParentForm = GetParentForm(PassedControl)
End Property

Private Sub chk_Click()
End Sub

Private Sub lst_Change()
End Sub

Private Sub spn_Change()
End Sub

Private Sub txt_Change()
End Sub

Private Sub CheckReadyState()
Dim HelpMessage As String
Dim ReadyState As Boolean

ReadyState = True
With m_ParentForm
    If .txtHeaderRowNum = "" Then
        HelpMessage = "Pick a Header Row"
        ReadyState = False
    ElseIf .lstChooser2.ListIndex <> -1 And .lstChooser1.ListIndex = -1 Then
        HelpMessage = "No Primary Column Picked"
        ReadyState = False
    ElseIf (.lstChooser1.ListIndex = .lstChooser2.ListIndex) And .lstChooser1.ListIndex >= 0 Then
        HelpMessage = "Duplicate Columns"
        ReadyState = False
        'If we got this far then there's no validation errors,
        'so if they've selected at least a primary column we're ready for the OK button
        ReadyState = .lstChooser1.ListIndex <> -1
    End If
    .cmdOk.Enabled = ReadyState
    SetHelpMessage HelpMessage
End With
End Sub

Function GetParentForm(ctl As MSForms.Control) As MSForms.UserForm
Dim ParentForm As Object

Set ParentForm = ctl.Parent
Do Until TypeOf ParentForm Is MSForms.UserForm And Not TypeOf ParentForm Is MSForms.Frame
    Set ParentForm = ParentForm.Parent
Set GetParentForm = ParentForm
End Function

Sub SetHelpMessage(HelpMessage As String)
m_ParentForm.lblError.Caption = HelpMessage
End Sub

The basic philosophy here is that a change to any control on the form, or, more accurately, any control having a WithEvents type in the public declarations of this class, triggers the validation routine. It doesn’t matter which control triggers it, the same things are validated. That distinguishes this class’s function, I hope, from the type of checking that syncs the spinbutton/textbox combo, for example what to do if the user tries to spin below zero. It also distinguishes the class functions from what happens when the OK button is clicked. Both those are handled within the userform itself.

Of course, the class does refer to individual controls on the userform as part of the validation, such as checking whether the same column was selected for both listboxes. Note that you can refer to the controls with something like “ParentForm.lstChooser1″ although there’s no IntelliSense for them.

I also messed around with a different way to refer to the parent form within the class. As Ross commented on an older post, passing the form to the class seems kind of clunky. I came up with a new clunky way in the “GetParentForm” function. It starts with the calling control and recursively checks parent controls until it climbs to the userform level. As mentioned in my last post, frames are seen as both frame and userform controls when using TypeOf, hence the double check in the “Do Until” line. I could have just checked the control’s TypeName, as mentioned in the last post, but with a form TypeName doesn’t return “UserForm.” It returns “frmWorksheetSplitter” or whatever you called it.

This is all kind of experimental on my part, and I’m sure parts of it could be made more object-oriented or otherwise improved, so let me know. I do like having the validation off in it’s own world, instead of mixing it in with the rest of the form code.

UserForm in action

The userform is similar to the one in A Flexible VBA Chooser Form. To see how it works, and how I populate the listboxes, and any number of wondrous things, download the workbook.