Archive for the ‘VBA’ Category.

Building an Excel Add-in

Hi there!

Only recently I read this quote somewhere: “If you want something done, ask a busy person”. I found two entirely different people as the originator of this quote: Benjamin Franklin and Lucille Ball. I wonder which it is…

Well, turns out I’ve been quite busy as of late. So I decided it was time to dust off some old stuff I prepared to add to my site but never came round to finishing (I must have become less busy when I was almost done :-) ).

If you’re about to embark on the journey to create an add-in out of a set of macro’s you have been using for some time now, this article is a nice read as it takes you through most of the steps needed when building an add-in for Excel.

Enjoy!

 

Jan Karel Pieterse

www.jkp-ads.com

 

AET Excel Utilities

Hi there. For the last few months I’ve been working on my main add-in, AET Excel Utilities.

Update
So far I’m in the process of setting up some partners, had a translation offer, and downloads are happening as I write this. Thanks very much to everybody for your help. Don’t be shy if you are interested!


I first started working on it in 2005, as a hobby, and a way to learn VBA. Over time it’s grown from having a handful of very simple tools, to what it is now – well over a hundred utilities (more like over two hundred), and some of them quite complex, even if I do say so myself. Useful? I like to think so. Not a day goes by that I don’t use it, and I can honestly say it saves me lots of time.

But there’s a problem. Even though I like these utilities, I’m not very good at selling myself, letting alone anything I’ve made. And in the world of Excel, most folk have either never heard of me or think I’ve retired if they have. That’s been fine until now, with me plugging away in a corner, tinkering away, but it’s always bothered me that my tools could be so much more.

So, I’d ask all of you for some help. I’m making the tools shareware. And I’m looking for people to help sell them. Do you have a site? If so, are you willing to become a partner or an affiliate? Like I say, I’m not great at sales so any assistance would be appreciated. Translations? Great! Let’s talk about a percentage. I guess the main thing is making people aware of them. Apart from making a bit of pocket money, serious interest will give me incentive to improve them and maybe even try to give my site a bit of an overhaul. (Please contact me using aengwirda [at] gmail.com if you are interested).

Here’s a few screenshots to whet your interest. (Well maybe more than a few…). Look to the left, the AET UTILITIES tab shares both my main utilities and free add-ins (which you can download here).

Worksheet Tools

Rows And Columns

Formula Tools

Deletion Tools

Object Tools

Export Tools

Text Tools

Number Tools

Time And Date

Chart Tools

Path And Folder

Workbook Tools

Developer Tools

Fun And Games

Other Utilities

Cell Menu

Row Menu

Column Menu

Sheet Menu

Here’s the download page link. On the same webpage, you can also download a copy of the Help files for more details on the individual tools, plus the password to see how the code works.

In addition to adding more tools over the next few weeks, I’ll be working on my free utilities too. More details on them, and also some new code samples, that I’m looking forward to posting about in the near future.

Creating Tables the Right Way

And by ‘right way’ I mean the way I want. JKP commented:

I wish MSFT would put a tablename box right into the “Format as Table” dialog as it is the first thing I do after formatting a range as a table. O, and always put that checkbox on. My tables always have a header row.

I couldn’t agree more. So why not repurpose Ctrl+T to do what I want.

Sub MakeTable()
   
    Dim sh As Worksheet
    Dim sName As String
    Dim lo As ListObject, loExists As ListObject
   
    Const sSHEETSTART As String = "Sheet"
    Const sTABLESTART As String = "tbl"
   
    Set sh = ActiveSheet
   
    'Get the name of the table from the user
    sName = Application.InputBox("Enter the table name", "Table Name")
   
    'If the user didn't click Cancel
    If sName <> "False" Then
        'Start the table with 'tbl' if it doesn't already
        If Left$(sName, Len(sTABLESTART)) <> sTABLESTART Then
            sName = sTABLESTART & sName
        End If
       
        'Create the table and name it
        Set lo = sh.ListObjects.Add(xlSrcRange, ActiveCell.CurrentRegion, , xlYes)
               
        'See if that name exists on this sheet
        On Error Resume Next
            Set loExists = sh.ListObjects(sName)
        On Error GoTo 0
       
        'If the name doesn't exist
        If loExists Is Nothing Then
            lo.Name = sName
           
            'If the sheet isn't already specifically named, name it
            If Left$(sh.Name, Len(sSHEETSTART)) = sSHEETSTART Then
                On Error Resume Next
                sh.Name = Replace$(lo.DisplayName, "tbl", vbNullString)
            End If
        End If
    End If

End Sub

This code makes a lot of assumptions about how I work with tables, so it may not work for you. First, I ask for the table name. I start all my table names with tbl, so if I don’t include that the code includes it for me. Next, I create a new ListObject based on the CurrentRegion of the ActiveCell. This is different than what Excel does. If you only have one cell selected, Excel will use the CurrentRegion. If you have more than one cell selected, Excel assumes you’ve defined the range you want and uses that. I put one table on one sheet and it’s the only thing on there. Therefore, I always want everything on that sheet to be the table.

Next, I see if a table with that name already exists on the sheet. If it does, skip the whole naming part.

Finally, I change the name of the sheet if it’s still named the generic ‘Sheetx’. I drop the ‘tbl’ part from the DisplayName property and name the sheet. The error avoidance is in case there’s already a sheet with that name. In that case, the name remains unchanged.

Why the DisplayName? If you name a table tblList, you can’t name another table tblList on the same sheet. In fact, in the user interface you can’t name another table tblList in the whole workbook. But in code, you can name another table tblList as long as it’s on a different sheet. If that name already exists, ListObject.Name remains tblList, but ListObject.DisplayName is changed to tblList_1. That’s why I check for the existence of that table on the same sheet but not the whole workbook. And that’s why I use the DisplayName to name the sheet.

I should have skipped all this error checking and just put a big On Error Resume Next at the top. I probably will never have two tables with the same name, and if I accidentally did, it would just keep the default name.

Weeding the KwikOpen Garden

A little less than a year ago, I said

Why 1,000 files? I don’t know. We’ll see how the performance holds up. I’ve been using it for three days and my text file is only up to 58 files – the 50 Excel stores plus eight additional. I guess it will take a bit longer to get to 1,000 than I thought, but I think it will be clear when there are too many and I can pare it down.

I hit 1,000 files a few days ago. Performance? Not even an issue. I upped it to 2000 and have been humming along nicely. The only downside is when I’m not on my machine and have to navigate the File Open dialog like an animal.

I know there are some files in my MRU that no longer exist. I didn’t try to delete them, I just let them stay in the list until I tried to open one and it said it didn’t exist. At the point, the code would allow me to navigate to its new location. I wanted to see how many files were no longer there.

Public Sub FindMissing()
       
    Dim clsRcntFiles As CRcntFiles
    Dim clsRcntFile As CRcntFile
    Dim lCnt As Long
   
    Set clsRcntFiles = New CRcntFiles
    clsRcntFiles.Fill
   
    For Each clsRcntFile In clsRcntFiles
        If Len(Dir(clsRcntFile.FullName)) = 0 Then
            Debug.Print clsRcntFile.FullName
            lCnt = lCnt + 1
        End If
    Next clsRcntFile
   
    Debug.Print lCnt
   
End Sub

This told me that it couldn’t find 234 files. That’s a lot. I really need a way to weed those files out of my MRU.

When I first wrote this code, I checked to see if the file existed before I added it to the listbox on the userform. If the file didn’t exist at that location, it didn’t get added to the listbox. If it didn’t get added to the listbox, it didn’t get written back out to the MRU. This culled the list nicely, but presented a problem pretty early on. A couple of days into using my new creation, I typed in a file name that I new I had recently opened. I didn’t remember that I moved that file to a different file. Of course, I go no results when I typed in the name even though I was certain I should have.

Once I realized why, I decided that having files disappear was not good for my psyche. It would be better to show the file, select it, then get a message that it didn’t exist. I removed the code that checked whether the file exists and didn’t implement anything that would remove files from the list short of clicking on them. Basically, I pushed that problem into the future. Well, the future is now. With 20% of my MRUs missing, I suppose it’s time to take a smarter tack.

I’m faced with a design decision. I need missing files to hang around for at least some amount of time, but not forever. Here are some choices I’ve been considering:

  1. Time stamps: I could time stamp each entry with the “last open date”. Entries less than one month old are never deleted. Missing entries older than one month get deleted automatically. The dissonance I experienced searching for a missing file that I was sure wasn’t missing occurred because I had had that file open within the last few days. I don’t think I would have the same experience with a file that I’d opened last month. Instead, I would assume I was misremembering as opposed to being crazy. I like the fact that this happens automatically – with no user intervention. I don’t like the fact that I have to store the date. My file goes from a clean, simple list to a data structure.
  2. Marking missing files: I could put an asterisk in front of files in the listbox that were missing. That way I would know what was missing and could click on them to clean them up, even if I didn’t intend to open them at that time. As I type this option, I hate it even more. Distracting myself with pointless housekeeping while I’m trying to get something done is a terrible idea.
  3. Cleanup utility: I could make a separate utility that the user could periodically run. It would list the missing files and allow the user to “find” any of them that he thinks is important and remove the rest. I wouldn’t have to touch any existing code or data for this, which is a positive. It’s not automatic like the #1, which is a negative.

I’ll probably go with #1, but I haven’t decided yet.

Joining Two Dimensional Arrays

The Join function takes an array and smushes it together into a String. I love the Join function. The only thing I don’t like about it is when I forget that it doesn’t work on 2d arrays. Join only works with 1-dimensional arrays. The last time my memory failed me, I decided to write my own. And here it is.

Public Function Join2D(ByVal vArray As Variant, Optional ByVal sWordDelim As String = " ", Optional ByVal sLineDelim As String = vbNewLine) As String
   
    Dim i As Long, j As Long
    Dim aReturn() As String
    Dim aLine() As String
   
    ReDim aReturn(LBound(vArray, 1) To UBound(vArray, 1))
    ReDim aLine(LBound(vArray, 2) To UBound(vArray, 2))
   
    For i = LBound(vArray, 1) To UBound(vArray, 1)
        For j = LBound(vArray, 2) To UBound(vArray, 2)
            'Put the current line into a 1d array
            aLine(j) = vArray(i, j)
        Next j
        'Join the current line into a 1d array
        aReturn(i) = Join(aLine, sWordDelim)
    Next i
   
    Join2D = Join(aReturn, sLineDelim)
   
End Function

It’s pretty simple. It loops through the first dimension (the row dimension) and joins each line with sLineDelim. Inside that loop, it joins each element in the second dimension with sWordDelim. What this function doesn’t do is automatically insert itself into only the projects I want. That requires me to remember that I wrote it and where I put it. In reality, I’ll probably reinvent the wheel the next time I need it.

Here’s my extensive testing procedure.

Sub TEST_Join2d()
   
    Dim a(1 To 2, 1 To 2) As String
   
    a(1, 1) = "The"
    a(1, 2) = "Quick"
    a(2, 1) = "Brown"
    a(2, 2) = "Fox"
   
    Debug.Print Join2D(a)
    Debug.Print
    Debug.Print Join2D(a, ",")
    Debug.Print
    Debug.Print Join2D(a, , "|")
    Debug.Print
    Debug.Print Join2D(a, ";", "||")
   
End Sub

Finding the Next Row in a ListObject in VBA

ListObjects (Tables in Excel’s UI) are structured ranges. I use them constantly. I love the built-in named ranges and referring to them in VBA without a lot of hullabaloo. It’s as close to a database as you’re going to get in Excel. Recently I decided to automate a process of adding some payroll records to the end of a table. If I were using just a range, I would find the next available row like

Set rStart = wshSalaries.Cells(wshSalaries.Rows.Count,1).End(xlUp).Offset(1,0)

That works most of the time for ListObjects too. It returns the row right below the last row of the ListObject. In most cases, when you add some data to that row, the ListObject expands. In the case where there is no data in the ListObject and there is only a blank row, however, it doesn’t work. The ListObject doesn’t expand, and even if it did, you would have a blank row.

The ListObject object has a InsertRowRange property that returns a Range object. When a ListObject has no data, it has a header row and a blank row[1] ready to accept data.

When you enter something into that row, it doesn’t give you a new insert row, it just sits there.

When I’m trying to write something to the end of a ListObject, I test to see if InsertRowRange is nothing[1]. Here’s a snippet

Set lo = wshSalaries.ListObjects(1)
If lo.InsertRowRange Is Nothing Then
    Set rStart = lo.HeaderRowRange.Cells(1).Offset(lo.ListRows.Count + 1)
Else
    Set rStart = lo.InsertRowRange.Cells(1)
End If

If InsertRowRange is Nothing, then table isn’t empty and I offset down however many rows there are plus one. The old method of End(xlup) works in this situation too. I don’t find top down better or worse than bottom up, so use whatever you like. If InsertRowRange isn’t Nothing, that means there’s no data in the table. In that case, I can insert starting in InsertRowRange.

Here’s the whole procedure, if you’re looking for context.

Public Sub ProcessWageFile()
   
    Dim clsEmployees As CEmployees
    Dim clsActives As CEmployees
    Dim clsEmployee As CEmployee
    Dim aOutput() As Variant
    Dim lCnt As Long
    Dim lo As ListObject
    Dim rStart As Range
   
    Set clsEmployees = New CEmployees
    clsEmployees.FillFromRange wshEmployee.ListObjects(1).DataBodyRange
    clsEmployees.FillCompsFromRange ActiveSheet.UsedRange.Offset(1)
    Set clsActives = clsEmployees.FilterByActive(True).FilterByHasComps
   
    ReDim aOutput(1 To clsActives.Count, 1 To 5)
   
    For Each clsEmployee In clsActives
        lCnt = lCnt + 1
        aOutput(lCnt, 1) = clsEmployee.FullName
        aOutput(lCnt, 2) = clsEmployee.Comps.Period
        aOutput(lCnt, 3) = clsEmployee.Comps.TotalWages
        aOutput(lCnt, 4) = clsEmployee.TotalBenes
        aOutput(lCnt, 5) = clsEmployee.Comps.TotalTaxes
    Next clsEmployee
   
    Set lo = wshSalaries.ListObjects(1)
    If lo.InsertRowRange Is Nothing Then
        Set rStart = lo.HeaderRowRange.Cells(1).Offset(lo.ListRows.Count + 1)
    Else
        Set rStart = lo.InsertRowRange.Cells(1)
    End If
   
    rStart.Resize(UBound(aOutput, 1), UBound(aOutput, 2)).Value = aOutput
   
End Sub

[1]: Now you get the disclaimer. There’s a lot you can do with Tables in Excel. You can have a header row or now header row. You can have a totals row or not. And you can have a bunch of other stuff that makes this code not work. I use Tables a lot from a UI perspective and sometimes I have various features on or off. But the way I’m using a ListObject in this example is as a datastore. It’s not meant to be messed with – only for the VBA to read from and write to. In those cases, I make the Table the only thing on the sheet, it always has a header, and it never has a total row. If you want to use Tables differently, you’ll have to modify the code to accommodate the differences.

Handling Specific Errors

A few years ago I posted my code for pasting values. It’s changed a bit since then. This morning, it looked like this:

Sub CopyPasteValues()
   
    gclsAppEvents.AddLog "^+v", "CopyPasteValues"
   
    If TypeName(Selection) = "Range" And Application.CutCopyMode = xlCopy Then
        Selection.PasteSpecial xlPasteValuesAndNumberFormats
    ElseIf Application.CutCopyMode = xlCut Then
        If Not ActiveSheet Is Nothing Then
            ActiveSheet.Paste
        End If
    End If
End Sub

If I’m copying, then I paste both the values and the number formats (but not other formats, comments, data validation, etc). I found that this was my most common need. When I only want values, I use Alt+E+S like in the old days. If I’m cutting, I can’t PasteSpecial, so I just Paste.

Usually I select the first cell where I want to paste and press Ctrl+Shift+V and the selection expands to fit the data. Sometimes, however, that expanded selection contains merged cells which causes an error. I’ve just ignored the error in the past, but I figured it was time to fix it. Now my code looks like this:

Sub CopyPasteValues()
   
    gclsAppEvents.AddLog "^+v", "CopyPasteValues"
   
    If TypeName(Selection) = "Range" And Application.CutCopyMode = xlCopy Then
        On Error GoTo ErrHandler
        Selection.PasteSpecial xlPasteValuesAndNumberFormats
    ElseIf Application.CutCopyMode = xlCut Then
        If Not ActiveSheet Is Nothing Then
            ActiveSheet.Paste
        End If
    End If
   
ErrExit:
    Exit Sub
   
ErrHandler:
    Select Case Err.Number
        Case 1004
            If IsNull(Selection.MergeCells) Then
                MsgBox "The range " & Selection.Address & " has merged cells. Can't paste"
            Else
                MsgBox Err.Description
            End If
        Case Else
            MsgBox Err.Description
    End Select
   
    Resume ErrExit
   
End Sub

Above the PasteSpecial line, I put an On Error statement to direct the program flow to an error handler. I didn’t apply that to the Cut portion of the code because cutting and pasting prompts me to unmerge cells and that’s the behavior I want.

In the error handling block, I check for the specific error 1004. I didn’t want to gloss over any old error, just this one in particular. If the error is 1004 (PasteSpecial method of Range class failed, or something like that), I then check to see if the new, expanded selection has any merged cells. While this is the only scenario that I’ve experienced that produces that error, it’s a pretty generic error and I’m sure there’s more. So I wanted to see the error description for any other errors.

To check for merged cells, I use IsNull(Selection.MergeCells). When the selection is more than one cell, the MergeCells property returns True if all the cells are merged, False, if none of the cells are merged, and Null if only some of the cells are merged. I don’t try to fix the situation, just display a somewhat meaningful error message. I don’t use merged cells all that often (it’s usually someone else’s spreadsheet, but not always). When I encounter this error, it’s usually because I copied more cells than I thought – hidden cells in the copy range. So it’s best to go back and start over.

At then end of the error block, it Resumes to ErrExit where it simply exits the sub. If there are no errors, the Exit Sub is executed before the ErrHandler label is reached.

Recent Update of Office causes problems with ActiveX controls

Hi,

Yesterday, I installed a host of updates, including some of Office.
As it happens, I tried to add an ActiveX control to a worksheet and received an error.
After some research I discovered the cause of the error to be two-fold:

1. The controls were updated by the update
2. Excel did not clean up after itself properly and left some temporary files behind.

The solution is to:
– Quit Excel
– Open Explorer
– Select C: drive
– Search for *.exd
– Remove all files found.

Hope this helps other people who might be suffering from the same problem.

Regards,

Jan Karel Pieterse
www.jkp-ads.com

#####UPDATE Dec 22, 2014#####
Microsoft has published a so-called Fixit to make resolving this matter easier:
https://support.microsoft.com/kb/3025036/EN-US?wa=wsignin1.0