Unique Entries in Userform Dependent Listboxes

Deepthi commented

…could you please help me tweak the code so that I can make multiple selections in listbox 1 in such a way that the values selected in list box two has all the values applicable for the selections made (listbox) but removes all duplicates?

First, a word about that post. I have used the relationship listbox template exactly zero times. I simply prefer to build my classes from scratch with names that reflect the business objects they represent. But I did reuse the userform and I didn’t change the control names from Parent/Child to Class/Student. I’m conflicted about that, but I’ll get over it.

Let’s say we have some classes and students. A class can have many students and a student can have many classes.

When you select a class, the userform lists the students. If you select more than one class, the userform lists all the student from the selected classes, but each student is listed only once.

Andrew and Payton are only listed once.

There are some significant changes to the code, not the least of which is removing the grandchildren. Also instead of tracking ActiveParent (singular), I now track ActiveClasses (plural) because my top listbox is now multiselect. When my Parent listbox changes, I have to see all the classes that are selected.

Private Sub lbxParents_Change()
   
    Dim clsClass As CClass
    Dim i As Long
   
    If Me.lbxParents.ListIndex <> -1 Then
        Set Me.ActiveClasses = New CClasses
        For i = 0 To Me.lbxParents.ListCount - 1
            If Me.lbxParents.Selected(i) Then
                Me.ActiveClasses.Add Me.Classes.ClassByClassName(Me.lbxParents.List(i))
            End If
        Next i
    Else
        Set Me.ActiveClasses = Nothing
    End If
   
    FillChildren
   
End Sub

Private Sub FillChildren()
               
    Me.lbxChildren.Clear
   
    If Not Me.ActiveClasses Is Nothing Then
        If Me.ActiveClasses.StudentCount > 0 Then
            Me.lbxChildren.List = Me.ActiveClasses.StudentList
            Me.lbxChildren.ListIndex = 0
        End If
    End If
   
End Sub

To get a unique student list, I use a dictionary object. My favorite thing about dictionaries is returning a zero-based array from the Keys or Items properties.

Public Property Get StudentList() As Variant
   
    Dim clsClass As CClass
    Dim clsStudent As CStudent
    Dim dcReturn As Scripting.Dictionary
   
    Set dcReturn = New Scripting.Dictionary
   
    For Each clsClass In Me
        For Each clsStudent In clsClass.Students
            If Not dcReturn.Exists(clsStudent.StudentName) Then
                dcReturn.Add clsStudent.StudentName, clsStudent.StudentName
            End If
        Next clsStudent
    Next clsClass
   
    StudentList = dcReturn.Keys
   
End Property

You can check out the rest of the code in the downloadable file.

You can download ParentChildUserformMulti.zip

Matching Column Widths

Here’s a report for a high volume, low margin product. Because the profit is so much smaller than sales and costs, column D is narrower than columns B and C.

Another example is the following table with names across the top. When the column widths are set to autofit, they all become different widths. Of course that simply won’t do.

Drag Multiple Columns

The first technique, and likely the most common, is to select all the columns and change the width of one of them. That will change the width of all of them. In the below figure, I select the entire columns B through K. It appears that column D is the largest so I select the column divider between D and E and drag it a few pixels to the right, then drag it back.

This changes all the selected columns to the width set for column D.

Well, that’s all I have to say about setting column widths. Of course I’m kidding. Let’s look at some keyboard only methods.

Format Column Widths

Select any cell in column D and click the Column Widths button on Home – Cells – Format (Alt + H + O + W). That will tell you the width of column D.

Make a note of the width and dismiss the dialog box (Esc). Now select cells in every column you want to change. For example, I selected B2:K2. It doesn’t have to be row 2. In fact, it could be multiple rows. All that matters is that every column that you want to change is included in the selection. Because the column widths aren’t the same, the Column Width dialog is empty.

I can type 8.43 in that box (the width of column D that I looked up earlier) and all the columns will be set to that width.

Paste Special

To use this method, select D2 and copy it (Ctrl+C). Next, select B2:K2 and choose Paste Special from the Ribbon (Alt + H + V + S). Choose the Column widths radio button (Alt+w) and click OK (Enter).

Build Your Own

You knew this was coming, didn’t you? Didn’t you? I wrote a macro and assigned it to Ctrl+Shift+W.

Public Sub MatchColumnWidths()
   
    Dim lMax As Double
    Dim rCell As Range
   
    gclsAppEvents.AddLog "^+w", "MatchColumnWidths"
   
    If TypeName(Selection) = "Range" Then
        If Selection.Cells.Count > 1 Then
            'if the first cell is active, set all columns to the biggest column
            If ActiveCell.Address = Selection.Cells(1).Address Then
                For Each rCell In Selection.Rows(1).Cells
                    If rCell.ColumnWidth > lMax Then lMax = rCell.ColumnWidth
                Next rCell
                For Each rCell In Selection.Rows(1).Cells
                    rCell.EntireColumn.ColumnWidth = lMax
                Next rCell
            'if the user selected a particular cell (not the first one), set
            'all columns to the selected column
            Else
                For Each rCell In Selection.Rows(1).Cells
                    rCell.EntireColumn.ColumnWidth = ActiveCell.ColumnWidth
                Next rCell
            End If
        End If
    End If
   
End Sub

Now I can select a range, press Ctrl+Shift+W, and my column widths are set. From the examples above, I select B2:K2, press Ctrl+Shift+W, and all the columns match the largest column (D). If you simply select a range, it will make all the columns the same size as the largest column. If you want to choose a different column, first select the range, then use the Tab key to move to the column you want to mimic.

If you want to mimic the first column, and it’s not the largest, you have to select more than one row and press Enter to move to first the column in the second row.

Cleaning Up My JoinRange Arguments

I’m trying to make my JoinRange function better and I’m failing miserably. A few years ago I added a “macro” argument because I was making so many HTML and Trac tables. I don’t use Trac anymore and I almost never make HTML tables (because I blog so infrequently, I guess). I got rid of that argument. The reason I join ranges most often is to create a big In clause in SQL. Let’s say I have this list of customer IDs and I want to make an In clause.

38
142
146
175
214
217

I’d use JoinRange like

=JoinRange(A2:A7,,"','","('","')")

That’s a freakin’ mess. The second argument is the now-defunct macro argument and is blank. The rest of the arguments are

3rd (delimeter): single quote, comma, single quote
4th (beginning): open paren, single quote
5th (ending): single quote, close paren

and I’d get

('38','142','146','175','214','217')

which I could paste into my SQL statement and roll. I hate typing those arguments. Worse, I hate reading those arguments. It’s pretty hard to read in this blog, but it’s worse in Excel’s formula bar. I thought if I could get rid of the single quotes, it would be cleaner. I rewrote the code to add a Quote argument that would wrap every entry in whatever quotes I supplied.

Public Function JoinRange(rInput As Range, _
    Optional sDelim As String = vbNullString, _
    Optional sLineStart As String = vbNullString, _
    Optional sLineEnd As String = vbNullString, _
    Optional sBlank As String = vbNullString, _
    Optional sQuotes As String = vbNullString) As String
   
    Dim vaCells As Variant
    Dim i As Long, j As Long
    Dim lCnt As Long
    Dim aReturn() As String
   
    vaCells = rInput.Value
    ReDim aReturn(1 To rInput.Cells.Count)
   
    For i = LBound(vaCells, 1) To UBound(vaCells, 1)
        For j = LBound(vaCells, 2) To UBound(vaCells, 2)
            lCnt = lCnt + 1
            If Len(vaCells(i, j)) = 0 Then
                aReturn(lCnt) = sQuotes & sBlank & sQuotes
            Else
                aReturn(lCnt) = sQuotes & vaCells(i, j) & sQuotes
            End If
        Next j
    Next i
   
    JoinRange = sLineStart & Join(aReturn, sDelim) & sLineEnd
   
End Function

Now, my formula looks like this:

=JoinRange(A2:A7,",","(",")",,"'")

I think we can all agree that this is no better than what I had before. I thought the quotes were the problem, but it’s also that I use a comma as the delimiter and it’s the thing that separates the arguments. If I change it to pipe delimited…

=JoinRange(A2:A7,"|","(",")",,"'")

Nope. It’s still a headache to read. Based on the number of comments to this post, I’m pretty sure none of you are using predefined names in your book.xlt file. But I do. And If I’m using a workbook that I created, I could use

=JoinRange(A2:A7,xlCOMMA,"(",")",xlSINGLE)

That’s definitely more readable to me. I guess I need a macro to add those names to any books automatically so I can use them.

Public Sub AddConstantNames()
   
    ActiveWorkbook.Names.Add "xlCOMMA", "="","""
    ActiveWorkbook.Names.Add "xlSPACE", "="" """
    ActiveWorkbook.Names.Add "xlDOUBLE", "="""""
    ActiveWorkbook.Names.Add "xlSINGLE", "=""'"""
    ActiveWorkbook.Names.Add "xlPARENO", "=""("""
    ActiveWorkbook.Names.Add "xlPARENC", "="")"""
    ActiveWorkbook.Names.Add "xlPIPE", "=""|"""
   
End Sub
=JoinRange(A2:A7,xlCOMMA,xlPARENO,xlPARENC,xlSINGLE)

I’m not crazy. I swear this all makes sense in my head. Plus, if you’ve read this far, you’re probably crazy too.

More Keyboard Metrics

Remember when I posted this post in 2014 about how often I’m using my homemade keyboard shortcuts? Well, how about an update.

A little bit of movement, but not a lot. I’m not sure what was up with IncrementDate and MakeYellow earlier this year.

Excel Survey Results

I hit 100 survey responses, so it’s time to pick a winner.

The two winners, John and Sean, have been contacted. If you don’t have an email from me, sadly, you didn’t win. Unless John or Sean fail to send me a proper mailing address, in which case you might still be a winner. But probably not. You should just go buy the book on Amazon to console yourself.


Excel 2016 Formulas Spreadsheets Bookshelf


Excel Power Programming Spreadsheets Bookshelf

I’m planning a post about making money from Excel. That’s part of the reason I did the survey. You don’t have to wait for my misinterpretations; you can see the survey results right now and misinterpret them for yourself.







Hyperlink Keyboard Shortcut Update

I have a custom keyboard shortcut, Ctrl+L, to “click” on a hyperlink in Excel. I thought I had posted that code, but I can’t find it. It’s not much.

If ActiveCell.Hyperlinks.Count > 0 Then
    ActiveCell.Hyperlinks(1).Follow
End If

It doesn’t work with links created with the HYPERLINK function because a formula doesn’t create a member of the Hyperlinks collection. I fixed it by parsing the formula and trying to follow the link inside.

Public Sub FollowLink()
   
    Dim vaSplit As Variant
    Dim sForm As String
   
    Const sLINKFORM As String = "=HYPERLINK("
   
    On Error GoTo ErrHandler
   
    If ActiveCell.Hyperlinks.Count > 0 Then
        ActiveCell.Hyperlinks(1).Follow
    Else
        If InStr(1, ActiveCell.Formula, sLINKFORM) = 1 Then
            sForm = ActiveCell.Formula
            sForm = Left(sForm, Len(sForm) - 1) 'remove last parent
            sForm = Replace(sForm, Mid(sLINKFORM, 2, 255), vbNullString) 'Remove function name
            vaSplit = Split(sForm, ",")
            If IsError(Evaluate(Join(vaSplit, ","))) Then 'friendly name argument used
                ReDim Preserve vaSplit(0 To UBound(vaSplit) - 1)
            End If
            ActiveWorkbook.FollowHyperlink Evaluate(Join(vaSplit, ","))
        End If
    End If
   
ErrExit:
    On Error Resume Next
    Exit Sub
   
ErrHandler:
    MsgBox Err.Description & vbNewLine & Evaluate(Join(vaSplit, ","))
    Resume ErrExit
End Sub

Here’s an example of a HYPERLINK formula I use.

=HYPERLINK(LEFT(SUBSTITUTE(CELL("filename"),"[",""),FIND(".",CELL("filename"))-2)&"_Backup.pdf","Backup")

This links to a file named CurrentFileName_Backup.pdf. The first thing the code does is remove the last parenthesis.

=HYPERLINK(LEFT(SUBSTITUTE(CELL("filename"),"[",""),FIND(".",CELL("filename"))-2)&"_Backup.pdf","Backup"

Next it removes the function name. It doesn’t remove the equal sign because I’ll need that for the Evaluate function later.

=LEFT(SUBSTITUTE(CELL("filename"),"[",""),FIND(".",CELL("filename"))-2)&"_Backup.pdf","Backup"

Next it splits the string on a comma. A comma will separate the link argument from the friendly name argument. This one has more than one comma, but we’ll deal with that later by Joining the array.

vaSplit(0) = =LEFT(SUBSTITUTE(CELL("filename")
vaSplit(1) = "["
vaSplit(2) = "")
vaSplit(3) = FIND("."
vaSplit(4) = CELL("filename"))-2)&"_Backup.pdf"
vaSplit(5) = "Backup"

The friendly name argument is optional. This example has a friendly name, but not every one will. To determine if the friendly name argument is used, I try to evaluate the string. A legitimate formula with a , friendly_name after it won’t evaluate and will return an error. If that’s the case, I remove the last element of the array and evaluate the remaining elements.

In this case, the Redim Preserve gets rid of element #5, but leaves the others intact. The remaining five elements are joined into

=LEFT(SUBSTITUTE(CELL("filename"),"[",""),FIND(".",CELL("filename"))-2)&"_Backup.pdf"

The Evaluate function turns into the result of the formula (the file is named JE35.xlsm).

S:\Accounting\General_Ledger_Information\201606\JE35\JE35_Backup.pdf

Passing that to FollowHyperlink opens the file. Unless it doesn’t exist. Then I get an error “Cannot open the specified file.” and a message box tells me the file name it tried to open. That way I can troubleshoot any problems before I go ask why the backup wasn’t included in this journal entry.

Windows API Viewer for MS Excel

This is a guest post by Dennis Wallentin.

The Tool

Windows API Viewer for MS Excel is a standalone, powerful tool for creating Windows API code, with or without conditions, to be inserted into code modules. It offers several lists of APIs for both platforms, x86 and x64, that can easily be used in various solutions. If wanted, it can create conditional Windows API solutions. The two conditions that can be applied are Win64 and VBA7. More information about them can be found in the help files shipped with the tool. The tool is shipped with extensive help support; the help includes help files and web pages that are relevant about Windows API.

The following screen shot shows the main form:

It is very easy to use Windows API Viewer. Select the code options you want and then export them to the clipboard. That’s all! Since it’s a standalone tool it can be used with other development tools. But the Windows APIs here are selected for MS Excel in particular. The tool’s help file explains and shows the various output you can create. Before the code solution is exported to the clipboard you can preview it as the following screen shot shows:

If you want further information about the selected Windows API the tool offers use of Google to find out more as the below screen shot shows:

Download

The Windows API Viewer for MS Excel is available in x86 version and in x64 version. To install it just double click on the downloaded exe file and follow the instructions on the screen.

Windows API Viewer – x86 Version
Windows API Viewer – x64 Version

Requirements

Since Windows API Viewer for MS Excel is not an add-in to MS Excel it can be used with whatever Excel version available. It can also be used with other development tools as well. However, the following requirements must be met in order to use the tool:

  1. Windows XP or later version.
  2. Microsoft.NET 4.0 or later version.

Development tools

The following tools have been used when creating Windows API Viewer for MS Excel:

  1. Microsoft Visual Studio 2015
  2. DevExpress WinForm Controls
  3. SQLite
  4. Help + Manual
  5. SamLogic Visual Installer 2015
  6. BoxedApp Packer

The Source Files

The Windows API sources come from two different text files by Microsoft. Unfortunately, the file for x86 Windows API is rather old, released by Microsoft in 1998. The other file was released when Excel 2010 was released and includes the x64 versions of Windows API. For obvious reason they are not complete. The quality has been improved as I have been forced to manually work with these files. All the Windows API are now stored in a SQLite database and can easily be updated when necessary. If you find some error or you see that some APIs are missing, please send me an e-mail and I will update accordingly. New versions of the tool will then be made available. By the way, did I mention that working with these files has been tedious?

License

The Windows API Viewer for MS Excel is made available based on the MIT License (MIT).

Home Page

Windows API Viewer has its home at Ron de Bruin’s site where upgrades and news will be published:
http://www.rondebruin.nl/win/dennis/windowsapiviewer.htm

Special Thanks
Special thanks goes to Ron de Bruin and Ken Puls.

All the very best,
Dennis

Double Your Pleasure

Can you believe this blog is 12 years old? In celebration of its birthday, I’m giving away a couple of books. Scroll down to the end if you just want the free stuff.

Personal Stuff
I had full knee replacement surgery in January. That’s less fun than it sounds. When the medical folks or former patients talk about knee replacements, they talk about the few days after surgery and they talk about week 7 and beyond. For the few days after surgery, everything is great because of the drugs. Week 7 is a nice turning point and roughly the time when people feel that it was worth it. The part in between those two sucks.

Physical therapy started the day after I was released from the hospital. Back in the good old days, you would lay around for six weeks to heal, then start physical therapy. Then someone realized that the scar tissue was fully formed in six weeks. So now they start it as soon as possible to get maximum range of motion before the scar tissue sets up. My last measurements were -1 and 122. Zero extension means your leg is straight. Normal people are negative, I think. On the flexion side, between 120 and 125 is normal for healthy knees. My good knee is only 122, so I was happy to get that.

I learned something about myself: I value efficiency and independence. OK, I probably didn’t “learn” that, but those facts were driven home as every task either took forever or had to be done by someone else. It was pure hell, I tell ya. I set up my work computer at home, but it was so slow I only tried to keep my inbox empty and fix emergencies. I went back to the office after four weeks. Week 5 sucked. When I told the doctor that I may have gone back a week too soon, he said “not necessarily”. He said that the first week back is terrible no matter how long you wait.

The recovery has gone as well as can be expected. I can walk three miles pain-free. I drove to St. Louis and after four hours in the car, I got out and walked around like a normal person. I used to have to limp around for 10 minutes until the joint got warmed up. It’s the little things. Speaking of little things, I rejoice in walking up and down stairs. My knee stays in line with the rest of my leg. A couple of weeks ago I tried to walk 18 holes. I’m not quite ready for that yet. My goal is walk 9 in a couple of weeks and go from there.

Daily Dose of Server Frustrations
After a nice run of no crashes, there have been several in the last month. They happen about 5AM my time, so the site is usually only down for a couple of hours before I notice it. Many of you probably didn’t notice it all. It is, without question, the most frustrating part of my existence. I actually considered turning everything into static web pages. Then I backed off the ledge.

I could go back to a web host. But they don’t really help. When something goes wrong, they just shut down the site so I don’t steal resources from other sites they’re hosting. Then I have to turn off all of my plugins to try to convince them to turn me back on. No, I won’t be going back to that. With Digital Ocean, I pay $120 per year and I can power cycle my server any ol’ time I want. But I’m not a server admin – not even close. So when my CPU spikes or my RAM spikes, I really have no idea what to do about it.

I’d like to find some blogging software that’s not WordPress and try that. I like Ghost, but it doesn’t support comments and that’s the best part of this site.

Free Stuff
Mike Alexander and I wrote some books recently.


Excel Power Programming Spreadsheets Bookshelf


Excel 2016 Formulas Spreadsheets Bookshelf

Rewrote, actually. And you can have one of them if the cost of shipping it to you is reasonable and if you complete this survey about your Excel spending habits:

https://www.surveymonkey.com/r/D5SXM3M

I’ll pick two survey respondents (one for each book) at random to receive a book. All the normal rules apply: if it’s illegal or causes me any heartache, it’s forbidden. You can take the survey even if you don’t want a book. At the end of the survey you can provide your name and email to be entered. If you skip that step, your survey results will still be included.