The Error Class Revisited

In the comments to Error Handling Via an Error Class, Peter found that the problem with this method is the absence of the Stop and Resume in the error handler than let you debug at the line that caused the error. Yeah, that stinks. Then Jase got me thinking that I just wouldn’t create the class in debug mode. Well, that wasn’t quite right. What needed to happen was that the error handler should not be set in debug mode. Here’s a rewrite of the entry point procedure.

Sub EntryPoint()
   
    Dim clsError As CError
   
    gbDebugMode = False
                   
    If Not gbDebugMode Then On Error GoTo ErrHandler
   
    Set clsError = New CError: clsError.SetLoc "Module1", "EntryPoint"
   
    SubProc1
     
ErrExit:
    Exit Sub
   
ErrHandler:
    Set clsError = Nothing
    MsgBox Err.Description
    Resume ErrExit
   
End Sub

When gbDebugMode is False, the error handler is set and it works as described in the original post. That is, the user gets a message box and the code exits gracefully. When gbDebugMode is True, the error handler is not set. It’s like you don’t have an error handler at all – because you don’t. When in debug mode, you get kicked to the line that caused the error.

Is that that last hurdle?

Back to Blogging

I just submitted the last chapter of a super-awesome new book project I’m doing with Mike Alexander. Submitting the last chapter is always a great feeling. I have no idea when it will be available, but I’ll be pimping it right here when I know. It’s a formulas book, and did I mention that it’s super-awesome?

Last month was the 10 year anniversary of DDoE. Wow, ten years feels like a long time. The only way to see the first post from March 2004 is in the wayback machine. It was lost in the great data loss event of a couple years ago. I had designs to restore all the lost posts, but it has not happened. I still have hope that will happen.

That first post was about summing between two dates. It was the old trick where you sum less than the greater date and subtract the sum of less than the lesser date. Now that Excel has SUMIFS, that trick is obsolete. That may be why I’m not so eager to get it back online.

Did you know that DDoE was originally at dicks-blog.com? John Walkenbach convinced me to start a blog during a trip to Seattle back in the day. We came up with the URL at the bar. I think he was trying to make hyphens more socially acceptable in URLs. The early aughts were a strange time.

If you follow DDoE, you know we’ve had some trouble here of late. Something has been spiking the memory and shutting down MySQL. It hasn’t happened in a while, but that may be because there hasn’t been much activity. Hopefully all that’s behind us. Thanks to Jeff Weir and the other contributors for all the posts they’ve made.

I’ve got several posts queued up (including one on keyboard shortcuts if you can believe that) so stay tuned for those and an announcement on when the new book will be hitting the shelves.

A VBA performance class

Hi everyone!

If you write a lot of VBA code you probably sometimes run into performance issues. A customer rings you and complains that the Excel file you built for them does not perform well. I’ve written a small article on my site, inspired by a post here: Error Handling via an Error Class. I needed a quick way to log and report performance of subroutines and I also wanted to see how many times a routine was called.

See: A VBA performance class

Enjoy!

Jan Karel Pieterse
www.jkp-ads.com

Paste and Transpose icon in QAT crash Excel 2013

Hi all

I add a new page on my site with a workaround for this problem. I hope that there are no more of this problem icons for the QAT.

Not easy find the problem with bugs like this, you not think that an Excel icon in the QAT can crash Excel.

Paste and Transpose icon in QAT crash Excel 2013
http://www.rondebruin.nl/win/s2/win018.htm

Regards Ron de Bruin

http://www.rondebruin.nl/

Daylight Saving Time Error

It’s DST here in the US and I couldn’t be happier. I don’t care if my drive to work is pitch black, but the drive home? That’s another story.

One thing I learned since the clocks sprung forward is that the GetTimeZoneInformation API doesn’t work the way I thought. The TIME_ZONE_INFORMATION return type has a Bias property. Bias tells you how many minutes you are away from GMT. Or so I thought. It actually tells you how many minutes you are from GMT in standard time. The TIME_ZONE return value tells you if it’s daylight saving time or standard time. So you have to take both into account to get the correct time.

Here’s the API declaration

Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type


Private Type TIME_ZONE_INFORMATION
    Bias As Long
    StandardName(0 To 31) As Integer
    StandardDate As SYSTEMTIME
    StandardBias As Long
    DaylightName(0 To 31) As Integer
    DaylightDate As SYSTEMTIME
    DaylightBias As Long
End Type


''''''''''''''''''''''''''''''''''''''''''''''
' These give symbolic names to the time zone
' values returned by GetTimeZoneInformation .
''''''''''''''''''''''''''''''''''''''''''''''

Private Enum TIME_ZONE
    TIME_ZONE_ID_INVALID = 0        ' Cannot determine DST
    TIME_ZONE_STANDARD = 1          ' Standard Time, not Daylight
    TIME_ZONE_DAYLIGHT = 2          ' Daylight Time, not Standard
End Enum


Private Declare Function GetTimeZoneInformation Lib "kernel32" _
    (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long

Private Declare Sub GetSystemTime Lib "kernel32" _
    (lpSystemTime As SYSTEMTIME)

And the updated procedure:

Public Function ConvertTimeToLocal(ByVal dtTime As Date, ByVal sZone As String) As Date
   
    Dim tzi As TIME_ZONE_INFORMATION
    Dim tz As TIME_ZONE
    Dim lGmtOff As Long
   
    tz = GetTimeZoneInformation(tzi)
   
    Select Case UCase(sZone)
        Case "EDT"
            lGmtOff = -4
        Case "EST", "CDT"
            lGmtOff = -5
        Case "CST", "MDT"
            lGmtOff = -6
        Case "MST", "PDT"
            lGmtOff = -7
        Case "PST"
            lGmtOff = -8
        Case vbNullString
            lGmtOff = -tzi.Bias / 60
    End Select
   
    If tz = TIME_ZONE_DAYLIGHT Then lGmtOff = lGmtOff - 1
   
    ConvertTimeToLocal = dtTime - (TimeSerial(0, tzi.Bias, 0) + TimeSerial(lGmtOff, 0, 0))
   
End Function

I also added a UCase around the zone because it’s just stupid not to have that. Enjoy saving the daylight, but remember you’ll owe it back this fall.

Update:

That’s why we write tests people.

Public Function ConvertTimeToLocal(ByVal dtTime As Date, ByVal sZone As String) As Date
   
    Dim tzi As TIME_ZONE_INFORMATION
    Dim tz As TIME_ZONE
    Dim lGmtOff As Long
    Dim lBias As Long
   
    tz = GetTimeZoneInformation(tzi)
   
    lBias = tzi.Bias
    If tz = TIME_ZONE_DAYLIGHT Then lBias = lBias - 60
   
    Select Case UCase(sZone)
        Case "EDT"
            lGmtOff = -4
        Case "EST", "CDT"
            lGmtOff = -5
        Case "CST", "MDT"
            lGmtOff = -6
        Case "MST", "PDT"
            lGmtOff = -7
        Case "PST"
            lGmtOff = -8
        Case vbNullString
            lGmtOff = -tzi.Bias / 60
            If tz = TIME_ZONE_DAYLIGHT Then lGmtOff = lGmtOff + 1
    End Select
   
    ConvertTimeToLocal = dtTime + (TimeSerial(0, lBias, 0) + TimeSerial(lGmtOff, 0, 0))
   
End Function

Public Sub Test_ConvertTimeToLocal()
   
    Dim dtTestTime As Date
   
    dtTestTime = TimeSerial(9, 46, 13)
   
    Debug.Assert (ConvertTimeToLocal(dtTestTime, vbNullString) - dtTestTime) < TimeSerial(0, 0, 1)
    Debug.Assert (ConvertTimeToLocal(dtTestTime, "CDT") - dtTestTime) < TimeSerial(0, 0, 1)
    Debug.Assert (ConvertTimeToLocal(dtTestTime, "EST") - dtTestTime) < TimeSerial(0, 0, 1)
    Debug.Assert (ConvertTimeToLocal(dtTestTime, "EDT") - (dtTestTime + TimeSerial(1, 0, 0))) < TimeSerial(0, 0, 1)
    Debug.Assert (ConvertTimeToLocal(dtTestTime, "CST") - (dtTestTime - TimeSerial(1, 0, 0))) < TimeSerial(0, 0, 1)
    Debug.Assert (ConvertTimeToLocal(dtTestTime, "MDT") - (dtTestTime - TimeSerial(1, 0, 0))) < TimeSerial(0, 0, 1)
    Debug.Assert (ConvertTimeToLocal(dtTestTime, "MST") - (dtTestTime - TimeSerial(2, 0, 0))) < TimeSerial(0, 0, 1)
    Debug.Assert (ConvertTimeToLocal(dtTestTime, "PDT") - (dtTestTime - TimeSerial(2, 0, 0))) < TimeSerial(0, 0, 1)
    Debug.Assert (ConvertTimeToLocal(dtTestTime, "PST") - (dtTestTime - TimeSerial(3, 0, 0))) < TimeSerial(0, 0, 1)

End Sub

Keyboard Shortcut Metrics

You all know that I love keyboard shortcuts. There is a limit, though. Some of my custom shortcuts clear the Undo stack, which can be a real pain, so I have to balance the productivity gains of the shortcut against the side effects. Back in January, I wanted to see which shortcuts I’d been using, so I created some code to keep track. The code is below, but first the results.

No surprise to me, pasting special – values tops the list. I paste values by default unless I need to paste something else. I should really just hijack Ctrl+V. If you’re wondering why the count for this one is so low in the first two-week period, it’s because I have severely ingrained muscle memory with Alt+E+S+V to show the Paste Special dialog and select the Values option. I wasn’t really using Ctrl+Shift+V, the shortcut assigned to this macro. I made an effort to use in early February. I’m not sure if I’ve ever posted this code before, so it’s high time.

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

You can see that I like to paste the values with the number formats.

If you want to see the code for the other macros in the list, see MakeComma, SelectAdjacentCol, FrozenHome, Wrap Sheets, Formatting Taskpane, Increment Date, ChangeSign, FillSeries.

I can’t find where I ever posted my FillVirtualScreen, CopySum, or GetMappedAddress code, so I guess I should do that in a future post. I was surprised that ShowFormatting wasn’t higher. Also, I thought DecrementDate would have been more used that IncrementDate. And FillSeries only seven times in two months?

To keep track of all this, I created a CLog class and a CLogs class. CLog has LogID, DateTime, Keys, and ProcName getter/setter properties. CLogs is a typical parent class with one exception I’ll show in a bit. In my App class, I added an AddLog and WriteLog procedure.

Public Sub AddLog(ByVal sKeys As String, ByVal sProcName As String)
   
    Dim clsLog As CLog
   
    Set clsLog = New CLog
    clsLog.Keys = sKeys
    clsLog.ProcName = sProcName
    clsLog.DateTime = Now
   
    Me.Logs.Add clsLog
   
End Sub

Public Sub WriteLog()
   
    Dim sFile As String, lFile As Long
   
    If Me.Logs.Count > 0 Then
        sFile = ThisWorkbook.Path & Application.PathSeparator & "UIHelpers.log"
        lFile = FreeFile
       
        Open sFile For Append As lFile
        Print #lFile, Me.Logs.LogFileLines
        Close lFile
    End If
   
End Sub

I had to go to every procedure I wanted to track and add a call to AddLog. Then whenever my App class goes out of scope, the log is written.

Private Sub Class_Terminate()
    Me.WriteLog
End Sub

In CLogs, I return all the log lines as a big string to write out to the file.

Public Property Get LogFileLines() As String
   
    Dim aWrite() As String
    Dim clsLog As CLog
    Dim lCnt As Long
   
    If Me.Count > 0 Then
        ReDim aWrite(1 To Me.Count)
       
        For Each clsLog In Me
            lCnt = lCnt + 1
            aWrite(lCnt) = clsLog.LogFileLine
        Next clsLog
       
        LogFileLines = Join(aWrite, vbNewLine)
    End If
   
End Property

That calls CLog.LogFileLine

Public Property Get LogFileLine() As String
   
    Dim aWrite(1 To 3) As String
   
    aWrite(1) = Me.DateTime
    aWrite(2) = Me.Keys
    aWrite(3) = Me.ProcName
   
    LogFileLine = Join(aWrite, "|")
   
End Property

This file has a bunch of other stuff in it including half-finished ideas, but if you like…

You can download UIHelpers.zip

Synchronising Slicers

Hi Everyone,

I’ve just added a new page to my site on how to synchronise slicers which point to different pivotcaches:
Synchronising Slicers

Enjoy the read!

Jan Karel Pieterse
www.jkp-ads.com

What’s Up at DDoE

Something is spiking memory on my server and MySQL is shutting down as a result. It doesn’t seem to matter how much memory I throw at it, it just maxes out and shuts down.

This morning I implemented a plan of shutting down plugins until it happens again. I started with a database reset plugin and so far so good. I’m not hopeful, though, because this is the same problem I had before moving to Digital Ocean, so I imagine it’s just a matter of time before it comes back. Here’s the order I’ll be disabling plugins

  1. WordPress Database Reset
  2. Authors Widget
  3. Subscribe to Comments Reloaded 3/21/2014
  4. CodeColorer
  5. Akismet
  6. WP Super Cache

If it gets down to Akismet, there’ll be trouble. The comment spam is crazy and there’s no way to keep up with it manually.

Keep enjoying the posts or the “error establishing database connection” error message, whatever happens to be showing that day.

How do you know if a ListObject has the autofilter applied?

If you try to filter a ListObject, and someone has turned the entire filter off by deselecting the Filter icon from the Data tab, then you’ll get an error. But how the heck can you easily test if the filter is on or not?

If you fire up the macro recorder, and click the Filter icon a few times to toggle it on and off, then you just get this:
Selection.AutoFilter
Selection.AutoFilter
Selection.AutoFilter

You can write

If Selection.AutoFilter = TRUE then...

but this simply serves to toggle the autofilter from it’s current state, and always returns true.

It seems to me that the only thing you can do is something like this:

Function FilterIsOn(lo As ListObject) As Boolean

Dim bOn As Boolean

bOn = False
On Error Resume Next
If lo.AutoFilter.Filters.Count > 0 Then
    If Err.Number = 0 Then bOn = True
End If
On Error GoTo 0
FilterIsOn = bOn
End Function

DataPoint Top and Left for 2007 or earlier.

Over at Datalabel height and width for 2007 or earlier Andy Pope says:

Another couple of properties that are not available prior to 2010 are the Left and Top values of the data point. If you want to know the position of the data point you need to get creative. Having determined the width and height of the data label you can then position the label left/right and above/below and calculate the data point.

Then Jon Peltier says:

Don’t spoil your afternoon moving datalabels around. If it’s an XY chart, then a little algebra goes a long way:
Horiz Position = plotarea.insideleft + plotarea.insidewidth*(X – Xmin)/(Xmax-Xmin)
Vert Position = plotarea.insidetop + plotarea.insideheight*(Ymax-Y)/(Ymax-Ymin)
… with corrections for plotting an axis in reverse order.

If it’s a line chart, the vertical position is as above, the horizontal position uses category number, total number of categories, and a correction for whether the axis crosses on or between categories.

If it’s a bar or column chart, you can get the length of the bar using the above (vert or horiz for column or bar chart), and if it’s stacked you need to sum them up appropriately. The width needs to take into account gap width, and if it’s clustered, how many series there are across each category.

All those potential Select Case statements that Jon will have to use give me the heebie-jeebies. So while I keenly await his forthcoming blog post on how to do things properly, I spent my afternoon being quick and dirty:

Function Pre2010_Position(dl As DataLabel) As String
Dim ptTop As Long
Dim ptLeft As Long
Dim dlLeft As Long
Dim dlTop As Long
Dim dlHeight As Long
Dim dlWidth As Long
Const lngPadding = 7

With dl
    dlTop = .Top
    dlLeft = .Left
   
    'Determine DL width and height
    dl.Left = ActiveChart.ChartArea.Width
    dlWidth = ActiveChart.ChartArea.Width - dl.Left
    dl.Top = ActiveChart.ChartArea.Height
    dlHeight = ActiveChart.ChartArea.Height - dl.Top
   
    dl.Position = xlLabelPositionRight
    If dl.Left + dlWidth = ActiveChart.ChartArea.Left + ActiveChart.ChartArea.Width Then
        'Datalabel is too wide to fit between point and plot edge
        dl.Position = xlLabelPositionLeft
        ptLeft = dl.Left + dlWidth + lngPadding
    Else:
        ptLeft = dl.Left - lngPadding
    End If
   
    dl.Position = xlLabelPositionBelow
    ptTop = dl.Top - lngPadding
    DoEvents
    dl.Position = xlLabelPositionAbove
    DoEvents
    If dl.Top + dlHeight + lngPadding > ptTop Then ptTop = dl.Top + dlHeight + lngPadding
   
    'Return DataLabel to original position
    .Top = dlTop
    .Left = dlLeft
End With
Pre2010_Position = dlWidth & "|" & dlHeight & "|" & ptLeft & "|" & ptTop

End Function

To test this, just select a DataLabel and run this:

Sub test()
Dim strPosition As String
Dim dl As DataLabel
Set dl = Selection

strPosition = Pre2010_Position(dl)

Debug.Print "dlWidth: " & Split(strPosition, "|")(0)
Debug.Print "dlHeight: " & Split(strPosition, "|")(1)
Debug.Print "ptLeft: " & Split(strPosition, "|")(2)
Debug.Print "ptTop: " & Split(strPosition, "|")(3)

End Sub

Note that I’ve got a couple of DoEvents in the Pre2010_Position routine. Without them, on my 2013 install it just doesn’t seem to work properly unless you step through the code one line at a time. Tedious, and annoying because you can see everything moving on the graph. But unavoidable, it seems. And tracking this down was what took the most time. Very frustrating.

For instance, without the DoEvents I get this:
dlWidth: 102
dlHeight: 51
ptLeft: 83
ptTop: 97

…whereas with them, I get this:
dlWidth: 102
dlHeight: 51
ptLeft: 83
ptTop: 64

Here’s my revamped LeaderLines file. Anyone with 2007 or earlier fancy taking this for a spin, and advising if it works?
Leader-lines_20140225-v10