Adding Stuff to the Top of a Dictionary

By in File Operations, Userforms and Controls on .

I wrote a KwikOpen addin that I use about a million times a day. I ran into a little nagging problem. When I Save As’d a file from the addin, it never showed up on the recently opened list. I finally decided to track down the bug. A while back, I switched my custom class storage method from Collection to Dictionary. I don’t remember why, but I’m sure it was a fine reason. I ended up with this Add method

Public Sub Add(clsRcntFile As CRcntFile, Optional ByVal bToTop As Boolean = False)
'    If clsRcntFile.RcntFileID = 0 Then
'        clsRcntFile.RcntFileID = Me.Count + 1
'    End If

    If Not mdcRcntFiles.Exists(clsRcntFile.FullName) Then
        mdcRcntFiles.Add clsRcntFile.FullName, clsRcntFile
    End If

    'Set clsRcntFile.Parent = Me
'    If bToTop Then
'
'        mcolRcntFiles.Add clsRcntFile, CStr(clsRcntFile.RcntFileID), 1
'    Else
'        mcolRcntFiles.Add clsRcntFile, CStr(clsRcntFile.RcntFileID)
'    End If
'
End Sub

I have this optional argument, bToTop, so I can add it to the front of the list. But as you can see from the commented code at the bottom, that argument is basically ignored. Dictionaries don’t allow you to insert values into specific locations and that code no longer works.

So why a bug? Because I only store the most recent 2,000 files, and I’m at that limit, any Save As’d file would become 2,001 and not written to disk. When I’d go to open a file, it would read in from the file again and, of course, that recently saved file was not there.

Surely there’s a quick and easy method for pushing something to the top. Nope. All I could find was rewriting the whole Dictionary.

Public Sub Add(clsRcntFile As CRcntFile, Optional ByVal bToTop As Boolean = False)

    Dim dcTemp As Scripting.Dictionary
    Dim i As Long

    If Not mdcRcntFiles.Exists(clsRcntFile.FullName) Then
        If bToTop Then
            Set dcTemp = New Scripting.Dictionary
            dcTemp.Add clsRcntFile.FullName, clsRcntFile
            For i = 0 To mdcRcntFiles.Count - 1
                dcTemp.Add mdcRcntFiles.Keys(i), mdcRcntFiles.Items(i)
            Next i
            Set mdcRcntFiles = dcTemp
        Else
            mdcRcntFiles.Add clsRcntFile.FullName, clsRcntFile
        End If
    End If

End Sub

In that code, I create a temporary Dictionary, dcTemp, put my Save As’d file in first, then fill in the rest, finally replacing the old Dictionary with the temporary one. That’s not exactly elegant, but it gets the job done. I tested it and found that the recently saved file was not on the top of the list. It was near the top, but I inserted it first, it should be at the top. Then I remembered that I read in Excel’s MRU before I read in my file. That means there are 50 files ahead of the one I just saved. No biggie, but it gave me an idea.

Instead of recreating the Dictionary, why don’t I just add it to the MRU? There are some websites about adding entries to the registry but that won’t work. Excel reads the registry when it opens and I wasn’t about to close and reopen the app. Another way to add a file to the MRU are to specify the arguments in the Open and SaveAs methods. I am saving a file. Now my Add method looks like this

Public Sub Add(clsRcntFile As CRcntFile)
       
    If Not mdcRcntFiles.Exists(clsRcntFile.FullName) Then
        mdcRcntFiles.Add clsRcntFile.FullName, clsRcntFile
    End If
   
End Sub

The heavy lifting is done when I save the file

    Dim fd As FileDialog
    Dim clsRcntFile As CRcntFile
    Dim clsError As CError
   
    If Not gbDebug Then On Error GoTo ErrHandler
    Set clsError = New CError: clsError.SetLoc "USaveAs", "cmdOpen_Click"
   
    Set fd = Application.FileDialog(msoFileDialogSaveAs)
   
    fd.InitialFileName = Me.lbxPlaces.Value & ActiveWorkbook.Name
   
    Select Case ActiveWorkbook.FileFormat
        Case 50: fd.FilterIndex = 3
        Case 52: fd.FilterIndex = 2
        Case 56: fd.FilterIndex = 4
        Case Else: fd.FilterIndex = 1
    End Select
       
    fd.Show
    'fd.Execute
   
    If fd.SelectedItems.Count > 0 Then
        Application.DisplayAlerts = False
            ActiveWorkbook.SaveAs fd.SelectedItems(1), , , , , , , , True
        Application.DisplayAlerts = True
'        Set clsRcntFile = New CRcntFile
'        clsRcntFile.FullName = fd.SelectedItems(1)
'        Me.RcntFiles.Add clsRcntFile, True
    End If

That lone True out there is the AddToMru argument. By getting rid of the .Execute method and doing the SaveAs myself, I also got rid of a problem where overwriting an existing file caused two warning prompts. Now there’s no need for me to add it to my list (the commented out code at the bottom) because Excel adds it to its list and that’s what I read first.

International Keyboard Shortcut Day 2016

By in Keyboard on .

It’s the first Wednesday in November and you know what that means. It’s International Keyboard Shortcut Day. The day when people from all over the world become far less efficient in an effort to be more efficient the rest of the year.

How to Participate

Pick on of the levels below and commit to advancing your keyboarding skills. You will be on your way to greater efficiency.

Participation Levels

Effecienado: When you’re in Excel, only use Ctrl, Shift, and the arrow keys to select cells, rows, and columns for at least one hour today. If you accidentally select a range with your mouse, select something else and do it again with your keyboard.

Key Master: Only navigate between applications with Alt+Tab. Only navigate between documents or tabs with Ctrl+Tab, Ctrl+PgUp/PgDown, or Ctrl+F6. Do this for at least four straight hours today. If you accidentally select an application, document, or tab with your mouse, go back to where you were and do it again with your keyboard.

Harry Keyboard Jr.: Put your wireless mouse on the credenza behind your desk. Only bring it to your desk when you absolutely have to, and return it when you’re done with that one activity. Do this for at least four straight hours today.

Storing Stuff in VBA Lists

By in Collections on .

You no doubt recall when snb wrote about Scripting.Dictionaires. Well, there’s more.

I use Collection objects in my custom class modules almost exclusively. It’s the only object, that I know of, that I can enumerate using For Each.

Outside of custom class modules, I use Dictionary objects. I used to avoid them because they weren’t built in to the language. I was always afraid of some dependency problem. But I’ve never seen one in all my years, so I’m over that now. The advantage of the Exists property and the ability to produce an array of keys or items is awesome. it’s probably more awesome than For Each, but I just haven’t made that leap yet.

And I never use ArrayLists because I never remember them. That’s not totally true. When I’m writing a procedure with a Dictionary and I need to sort, I kick myself for not using an ArrayList.

Here’s some features of Collections, Dictionaries, and ArrayLists.

Feature Collection Dictionary ArrayList
New Enum in class Yes No No
Exists No .Exists .Contains
Key Value paradigm Yes Yes No
Unique keys Yes Yes NA
Key data types String Any NA
Get keys No Yes NA
Auto create items No Yes No
Insert anywhere .Add(,,before,after) No .Insert
Output to array No .Keys or .Items .ToArray

There are other differences. Those are just the ones that are important to me. If there’s a difference that’s important to you, leave a comment. You can read everything you ever wanted to know about these objects at one of the pages below:

Collections: http://www.snb-vba.eu/VBA_Collection_en.html
Dictionaries: http://www.snb-vba.eu/VBA_Dictionary_en.html
ArrayLists: http://www.snb-vba.eu/VBA_Arraylist_en.html

Fun with Excel; A Wheel Of Fortune

By in Automation, Downloads, For Normal People, MVP, VBA on .

Hi everyone,

Long time no see!

It seems the busier one is, the more work gets done. I’ve published a nice article today, in which I explain how I created a Wheel Of Fortune made entirely in Excel some years ago. This is what it looks like:

Wheel Of Fortune

Wheel Of Fortune

Enjoy!

Jan Karel Pieterse

www.jkp-ads.com

New Computer Setup

By in Uncategorized on .

I got a new computer at work. This is how big it is.


It’s got an i7-6700T @2.8GHz and 16GB or RAM. All in that little box. It also has Windows 10, which I’m finding quite acceptable. I guess I should have upgraded my home computer when it was free. I’m opposed to Microsoft’s Windows 10 revenue model on principal and that really hasn’t changed.

The other major change is that I have Office 2010 64 bit. You can read some of my comments at the bottom of this post. To be fair, Microsoft doesn’t recommend installing 64 bit unless you have a specific reason. I don’t have a good reason, I just want Excel to address as much memory as possible. And it does. And it’s super-fast. Except when it crashes. My email to IT reads as follows:

I give up. Office 64bit sucks. When you have time, I’d like it uninstalled and 32bit installed.

Thanks,
Dick

Finally, I’m making the switch from Firefox to Chrome. It’s been an adjustment, but generally I like it. My biggest blocks to switching have been Type Ahead Find and the treatment of diverted tabs. I installed an extension called Type-ahead Find that takes care of the first problem. And I installed an extension called Inoreader Companion which takes care of the second problem within Inoreader. The vast majority of diverted tabs for me happen in Inoreader. I still don’t like how Ctrl+Click opens the tab just to the right rather than at the end, but it’s only a minor annoyance and I’ll get used to it.

Here are the rest of the settings I make when I do a clean install.

Windows

  • Pin programs to taskbar.

    That’s Outlook, Chrome, Excel, an RDP to our accounting software, SQL Server Management Studio, and Notepad++. I leave Outlook running all the time so it processes my client side rules. I start the rest of them each morning by holding down the Windows key and typing 23456. Everyone in my office closes the entire application when they’re done with it (except Outlook). That means every time they want to work in Excel, they start Excel. They don’t have 16 GB of RAM, either, so it takes a few seconds. I just don’t understand why they don’t leave it running all day.

  • Uncheck Hide Extensions for Known File Types
  • Check Show Hidden Files. I did these the old fashioned way, but have discovered that they are on the View menu in Windows Explorer. They’re called File name extensions and Hidden items. Just another little Windows 10 convenience. Although I still argue that File extensions should be on by default.
  • I use Ctrl+Alt+Down and Ctrl+Alt+Right for a couple of Excel macros so I can’t have them rotating my screen around.

Excel

  • Uncheck Show Mini Toolbar on Selection
  • Include this many sheets = 1
  • Uncheck Use GetPivotData functions for PivotTable references
  • Turn off Autocorrect – Replace as you type: Internet and network paths with hyperlinks
  • Uncheck Allow editing directly in cells
  • Uncheck Show paste options button when content is pasted
  • Show this number of Recent Documents = 50
  • Uncheck Show all windows in taskbar
  • Add Max and Min to Status bar

Visual Basic Editor

  • Tools – Options – Break in Class Modules
  • Uncheck Auto Syntax Check
  • Check Require variable declaration
  • Comments to gray and Keywords to green. I don’t write a ton of comments. I’m a proponent of writing self-documenting code and only commenting when necessary. But when I do comment, I certainly don’t want it slapping me in the face. If I need clarification, I’ll look for comments. Otherwise I prefer not to see them. I realize there are others in the VBA community who have the exact opposite opinion. I’m in favor of people having opinions about programming in VBA even if I don’t share them.

  • Add CommentBlock and Uncomment Block to Tools menu

Outlook

  • Compose messages in this format: Plain Text
  • When a new message arrives Play a sound – off
  • When a new message arrives Briefly change the mouse pointer – off
  • When a new message arrives Display a Desktop Alert – off
  • Check When replying to a message that is not in the inbox, save the reply to the same folder
  • Check Always send a read receipt. I hate that some people always request read receipts. But I also hate that prompt, so I just gave in.

SQL Prompt

  • Add space as special character
  • Put commas as start of row
  • Put space after comma
  • Add snippet gob = GROUP BY $PASTE$ ORDER BY $PASTE$ I have to copy the SELECT list for this to work. I wish I could make it work without copying. That is, it would group by and order by everything in the SELECT list that wasn’t an aggregate.
  • Add snippet ssfgross = SELECT * FROM dbo.OSASGrossMargin_vw WHERE GLYear = $DATE(yyyy)$ Just a query I start with a lot. We’re a fiscal year end, so the $DATE$ variable doesn’t quite work.

One last word about 64 bit office. You can’t program the menus in the VBE as I documented here. My temporary fix for that was going to be AutoHotKey. This is bad, so be sure to plug your nose if you choose to consider reading. Here’s my AHK script:

:*:vbInsMod::Application.Run("VBHelpers.xla{!}InsertModule")
:*:vbPrivate::Application.Run("VBHelpers.xla{!}ConvertPublicToPrivate")
:*:vbParent::Application.Run("VBHelpers.xla{!}CreateParentClass")
:*:vbReset::Application.Run("VBHelpers.xla{!}ResetVBEState")
:*:vbFindBy::Application.Run("VBHelpers.xla{!}CreateFindBy")
:*:vbFill::Application.Run("VBHelpers.xla{!}MakeFillFromRange")
:*:vbCallers::Application.Run("VBHelpers.xla{!}ListProcedureCallers")

I’d go to the Immediate Window and type, for example, vbPrivate. It would expand into an Application Run statement and I’d press Enter to execute. I told myself that this is how I would access these procedures until I was able to rewrite this as COM add-in or a .Net thingy or however people automate the VBE these days. I’m pretty sure I would have just kept using this method and never actually rewrote it. Now that I’m switching back to 32 bit, it’s a non-issue.

I hope you’ve enjoyed this small glimpse into my computing life.

Deleting Pivot Table Drilldown Sheets

By in PivotTables, VBA on .

I tried to make drilling into pivot tables better once upon a time. I failed. Earlier this week, I read Debra’s blog post about showing details and deleting the sheets later. It got me thinking.

The problem I have is that her solution (and many others) rely on the Before_DoubleClick event. As you might imagine, I don’t double click to show pivot table details. I press the context menu key and choose Show Details from the menu. I need a different event or to capture that context menu item. I don’t think there’s any event that will allow me to identify new sheets only when they come from showing details of a pivot table. It doesn’t matter. The better answer is create my own shortcut.

In my Auto_Open and Auto_Close procedures in my PMW:

Application.OnKey "^+d", "PTDrillDown"

Application.OnKey "^+d"

That’s Ctrl+Shift+D for the uninitiated. That will now run PTDrillDown

Public Sub PTDrillDown()
   
    Dim pt As PivotTable
       
    On Error Resume Next
        Set pt = ActiveCell.PivotTable
    On Error GoTo 0
   
    If Not pt Is Nothing Then
        If Not Intersect(ActiveCell, pt.DataBodyRange) Is Nothing Then
            ActiveCell.ShowDetail = True
       
            On Error Resume Next
                Application.DisplayAlerts = False
                    ActiveWorkbook.Sheets(gsDRILLSHEET).Delete
                Application.DisplayAlerts = True
            On Error GoTo 0
            ActiveSheet.Name = gsDRILLSHEET
        End If
    End If
   
End Sub

Lot’s of On Error's in there. That’s the sign of really tight code, you know. This determines if the ActiveCell is in a pivot table by trying to set a PivotTable variable. If it’s in a pivot table, it next checks to see if it’s in the body (as opposed to row or column headers or filters). If it’s in the body, the code shows the detail, deletes any sheet with my special name, and names the resulting sheet with my special name. The special name lives in my MGlobals module.

Public Const gsDRILLSHEET As String = "_PivotDrill"

And for the coup de grace, I have a class module that defines an Application variable WithEvents. I added this event procedure to it.

Private Sub mxlApp_SheetDeactivate(ByVal Sh As Object)
   
    If Sh.Name = gsDRILLSHEET Then
        Application.DisplayAlerts = False
            Sh.Delete
        Application.DisplayAlerts = True
    End If
   
End Sub

Whenever I switch off of the details sheet, it goes away. Now that’s keeping things tidy.

KwikOpen Update

By in File Operations, Userforms and Controls on .

A year and a half ago, I decided that I was going to make a change to my KwikOpen add-in to get rid of recent files that no longer exist. Well, I finally got it done. No, it didn’t take that long to implement. The performance of the add-in has been fine so there wasn’t a pressing need. The other day, the addin seemed a little less peppy than usual and I thought it was time for a look.

I had 2,368 files in my MRU and 465 of them are dead links. That’s about 20% and it’s similar to the proportion I saw back in February 2015. Of the three options I listed at the bottom of my previous post, I chose none of them. Instead, I weeded out some files as I wrote them back out to disk.

Public Sub WriteToDisk()
   
    Dim sFile As String
    Dim lFile As Long
    Dim clsRcntFile As CRcntFile
    Dim aFiles(1 To 3000) As String
    Dim lFileCnt As Long
    Dim lWriteCnt As Long
       
    Const dWEEDLIMIT As Double = 0.9
   
    For Each clsRcntFile In Me
        lFileCnt = lFileCnt + 1
        If lFileCnt < Me.Count * dWEEDLIMIT Or clsRcntFile.Exists Then
            lWriteCnt = lWriteCnt + 1
            aFiles(lWriteCnt) = clsRcntFile.FullName
        End If
        If lWriteCnt >= UBound(aFiles) Then Exit For
    Next clsRcntFile
   
    sFile = Environ$("APPDATA") & "\Microsoft\Addins\" & msMRUFILE
    lFile = FreeFile
   
    Open sFile For Output As lFile
    Print #lFile, Join(aFiles, vbNewLine)
    Close lFile
   
End Sub

The file names are written to the file with the most recent at the top – sort of. Because I’m using the built-in MRU as well as my own, it’s not exactly that way, but it’s close enough for government work. Instead of time stamping the entries, I decided to dump any nonexistent files that were near the bottom of the list. If a file is in the top 90% of the list, it stays regardless of whether it exists. If it’s in the bottom 10%, it only stays if it’s still where it was.

Iteration Total Files Orphaned Files
Beg. 2,368 465
1 2,250 345
2 2,226 321
3 2,225 320

Looking at the last 100 or so files, they’re mostly from 2014. I could cap this at 2,000 and probably not notice.

Moving Sheet Groups within a Workbook

By in Keyboard on .

Last week I created a keyboard shortcut to move a sheet within a workbook. This week I’m changing it to work with groups of sheets rather than just the active sheet. Not because I need it. I rarely work with grouped sheets as it is. But sometimes you have to program just for the fun of it.

This will require a change to NextVisibleSheetIndex function. I tried to determine if the ActiveSheet was in a group and where it was in the group. That resulted in some inelegant code and I could tell I was doing it wrong. Then I realized that I should stop futzing with the ActiveSheet and just pass a sheet into the function where I want to start. That made things much simpler.

Public Function NextVisibleSheetIndex(ByRef shStart As Object, ByVal bDown As Boolean) As Long
   
    Dim lReturn As Long
    Dim i As Long
   
    If bDown Then
        For i = shStart.Index + 1 To ActiveWorkbook.Sheets.Count
            If ActiveWorkbook.Sheets(i).Visible Then
                lReturn = i
                Exit For
            End If
        Next i
    Else
        For i = shStart.Index - 1 To 1 Step -1
            If ActiveWorkbook.Sheets(i).Visible Then
                lReturn = i
                Exit For
            End If
        Next i
    End If
   
    NextVisibleSheetIndex = lReturn
   
End Function

That kept the function code cleaner, but I still had to figure out what sheet to pass in. Well, that turned out to be really easy. If It was moving left, I pass in the first sheet in the group.

Sub MoveSheetsUp()
   
    Dim ssh As Sheets
   
    Set ssh = ActiveWindow.SelectedSheets
   
    If ssh(1).Index = FirstVisibleSheetIndex Then
        If Timer - msnLastWrap > msnWRAPBUFFER Then
            gclsAppEvents.AddLog "^%{PGUP}", "MoveSheetsUp"
            ssh.Move , ActiveWorkbook.Sheets(LastVisibleSheetIndex)
        End If
    Else
        ssh.Move ActiveWorkbook.Sheets(NextVisibleSheetIndex(ssh(1), False))
    End If
   
    msnLastWrap = Timer
   
End Sub

And if I’m moving right, I pass in the last sheet.

Sub MoveSheetsDown()
   
    Dim ssh As Sheets
   
    Set ssh = ActiveWindow.SelectedSheets
   
    If ssh(ssh.Count).Index = LastVisibleSheetIndex Then
        If Timer - msnLastWrap > msnWRAPBUFFER Then
            gclsAppEvents.AddLog "^%{PGDN}", "MoveSheetsDown"
            ssh.Move ActiveWorkbook.Sheets(FirstVisibleSheetIndex)
        End If
    Else
        ssh.Move , ActiveWorkbook.Sheets(NextVisibleSheetIndex(ssh(ssh.Count), True))
    End If
   
    msnLastWrap = Timer
   
End Sub