Archive for the ‘VBA’ Category.

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

VLOOKUP & INDEX/MATCH Are Both Badly Designed Functions: Here Are Some Better Ones

It’s fun to argue about whether VLOOKUP or INDEX/MATCH is better, but to me that’s missing the point: they are both bad.

So I decided to design and build some better ones.

VLOOKUP INDEX/MATCH problems

Here are some of the more-frequently mentioned VLOOKUP INDEX/MATCH problems

  • Slow exact match (linear search)
  • Approximate sorted match is the wrong default 99.9% of the time and gives the wrong answer without warning
  • Cannot do exact match on sorted data (well they can but only if they ignore sorted!)
  • Numeric VLOOKUP answer column easy to break
  • No built-in error handling for exact match
  • VLOOKUP very inflexible
  • INDEX/MATCH more flexible but still limited
  • ¬†…

MEMLOOKUP/MEMMATCH – easier and faster alternatives to VLOOKUP/MATCH

MEMLOOKUP ( Lookup_Value, Lookup_Array, Result_Col, Sort_Type, MemType_Name, Vertical_Horizontal )

The syntax is designed to make it easy to convert a VLOOKUP to MEMLOOKUP, but there are differences!

  • Defaults to Exact Match on both unsorted and unsorted data
  • Use either column labels or numbers
  • Fast exact match on both unsorted and sorted data
  • Automatic optimisation of multiple lookups within the same row

So you want more flexibility? Try the AVLOOKUP/AMATCH family of functions

It’s always tempting to cram in more function (scope creep is universal), but if the result is too many parameters then it’s a mistake. So instead there is a whole family of these lookup functions that build on the MEMLOOKUP/MEMMATCH technology to provide the ultimate in flexibility and power whilst remaining efficient.

  • Lookup using any column
  • Lookup using more than one column without slow concatenation
  • Lookup the first, last, Nth or all results on both sorted and unsorted data
  • Lookup both rows and columns (2-dimensional lookup is built-in)
  • Built-in error handling for exact match
  • Return multiple answer columns
  • Case-sensitive lookup option
  • Regex match option

Lookups1

Try them out for yourself

These functions are included in the 90 or so additional Excel functions built into FastExcel V3.
You can download the trial version from here.

Download FastExcel V3

If you like them then ask Microsoft to add them to the next version of Excel!

I would be delighted to tell the Excel team how I built these functions and the algorithms they use.

By the way they are written as C++ multi-threaded functions in an XLL addin for maximum performance.

 

 

The Future of VBA Development

Remember nine years ago when I posted about the future of vba? Neither did I, but I just re-read it. I think if we keep talking about how VBA is dead, it might actually die someday. Nah, probably not.

John at Global Electronic Trading has the latest VBA eulogy. He asked several VBA community members (including me) to answer four questions about the future of VBA. Here is my response to what killed VBA

[DK] Time killed it. Nothing last forever. Cobol developers were once in high demand. Now Cobol developers are in very high demand – both of them. Microsoft killed it by not updating the IDE or supporting VBA as a viable development platform. Had they invested in VBA, say by integrating .Net into Office the way they did with VB, then it still may have been a viable platform today. But even if that were true, time would kill it eventually.
The internet killed it by adopting Ajax. A lot of developer resources went to web apps and away from COM based development.

Apple killed it by inventing the App Store. None of those developer resources came back to COM, they’re all developing mobile apps now.
So a bunch of stuff killed VBA, but all that means is that evolution killed it. MS evolved their development platform away from VBA just like they evolved away from ANSI C before that.

Go read the rest of the answers. You won’t be surprised by any of the answers, I’ll bet.

I draw two conclusions from this experience:

  1. I need to proof read my emails before I send them.
  2. I don’t care if VBA is dead. It still works for me now, I’m very effective with it, and I’m still solving real problems using it every day. If it’s dead, it’s the best damn corpse in the office.

Putting together an Excel VBA course

Hi everyone!

I’m putting together an advanced VBA course and I am looking for feedback, as I plan to make this a top-notch training.
If you have a couple of minutes to spare (or perhaps are interested in attending an advanced VBA training in The Netherlands), please fill out my survey

Thank you in advance!

Regards,
Jan Karel Pieterse

A Better AutoFilter

Jeff recently wrote about how you can type your filter criterion in a Pivot Table’s page field and it will filter it automagically. That’s awesome. I want the same thing when I filter Tables, so I started doing some experiments. To filter a table, you select the header, press Alt+{DOWN}, e to get to the search box, and type the search term.

Press Enter

I want to type ‘Colorado’ right in the header and have it filter.

Voilà

How did I accomplish that magic? First I created a class module call CApp. It will be used to house my application level events. Up in the declarations section of CApp, I have this

Private WithEvents mclsApp As Application
Private msOldValue As String

Public Property Let OldValue(ByVal sOldValue As String): msOldValue = sOldValue: End Property
Public Property Get OldValue() As String: OldValue = msOldValue: End Property
Public Property Set App(ByVal clsApp As Application): Set mclsApp = clsApp: End Property
Public Property Get App() As Application: Set App = mclsApp: End Property

The mclsApp variable is declared WithEvents so that VBA exposes all the events of the Application object to me in this module. I’ll be using two of those events, SelectionChange and Change, to determine when to filter. The OldValue variable will hold the header that I’m overtyping so I can put it back. For instance, when I replace State (the column heading) with Colorado (the search term), I need to put the heading back to State.

To capture that old header value, I use the SheetSelectionChange event. Whenever the selection changes, this procedure is run.

Private Sub mclsApp_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

    Dim rLoHeader As Range
       
    'See if the target is in the header of a listobject
    On Error Resume Next
        Set rLoHeader = Intersect(Target, Target.ListObject.HeaderRowRange)
    On Error GoTo 0
   
    'If it's in a header, save the header's column heading
    If Not rLoHeader Is Nothing Then
        Me.OldValue = Target.Value
    Else
        'Otherwise, clear the old value
        Me.OldValue = vbNullString
    End If

End Sub

If I’ve select a cell that’s in the header of a ListObject (that’s what VBA calls a Table), then save the value. This is just some test code. It needs far more error proofing, such as making sure only one cell is selected.

Next I use the SheetChange event to monitor if I type a new value in that header. First I disable events so that when I put the old header value back, it doesn’t think I’m trying to filter again.

Private Sub mclsApp_SheetChange(ByVal Sh As Object, ByVal Target As Range)
   
    Dim sFilter As String
       
    Application.EnableEvents = False
   
    If Len(Me.OldValue) > 0 Then
        'Save the search term for later filtering
        sFilter = Target.Value
        'Change the header value back
        Target.Value = Me.OldValue
        'This shouldn't be necessary, but read on
        Me.OldValue = vbNullString
       
        'Filter based on the value typed
        Target.ListObject.Range.AutoFilter Target.ListObject.ListColumns(Target.Value).Index, sFilter
       
    End If
   
    Application.EnableEvents = True
   
End Sub

I really don’t mind using the built-in autofilter string of keystrokes when I’m filtering on a string or a number. But dates? That’s another story. I hate autofiltering on dates. If I want to filter the above list on June 22nd, the keystrokes are: Alt+{DOWN}, e, {TAB}{TAB}, {SPACE} to uncheck Select All, {DOWN}{DOWN}{RIGHT} to expand June, 2 2 {SPACE} to get to the second entry that starts with a ‘2’ and check it, {ENTER}.

Stupid. I should be able to get to the search box and type 6/22 and have it filter. But it doesn’t. I though this method would make filtering on dates much better. And I was right.

Did you happen to see the comment in the above code about a particular line not being necessary? I didn’t want to remove OldValue in the SheetChange event because that’s the job of the SheetSelectionChange event. I shouldn’t need to do it. I didn’t need to do it for filtering on strings, but without it, I can’t filter on numbers or dates. For some reason that I couldn’t figure out, the SheetChange event was being called twice. The first time it would filter on ‘6/22/2014′ as expected. Then it would run again (even though I clearly have turned off events) and would filter on ‘Date’ (the column header), which, of course, it can’t find in a column of actual dates.

I even tried to make my own event enabler/disabler, but it didn’t matter. Once I set OldValue to vbNullString, filtering on numbers and dates started working. The event procedure still gets called twice, but it doesn’t try to filter because OldValue isn’t there anymore.

That leaves a potential problem. If I type, say, “Montana” in B1 and enter using Ctrl+Enter rather than just Enter, the selection doesn’t change and OldValue is blank. Now, before selecting any other cells, if I type ‘Colorado’, nothing happens. That’s not a big problem for me because I have my options set to go down on enter and wouldn’t really use Ctrl+Enter in that case. But that doesn’t mean I like it. I don’t.

This hasn’t made it into my PMW yet, but I’d like to see where it can go.

You can download BetterAutoFilter.zip