Friday 4 November 2011

The Flasher: Show A Cell, Cells, Or Merged Cells With A Warning Colour

This is a common theme: your sheet contains a cell for a file location, some macro runs with the value, and fails because the file address is invalid.

Fine, we've all written error-handlers for that, and we can write informative error messages telling the user what's gone wrong, and what to do next.

And we all *do* do this... Right?

As useful bit of user interface work is to flash up the range with the bad data, changing the background colour to red, and back again, two or three times. It's an easy bit of code to write, until you run into ranges containing merged cells - which are a nuisance, but an occasional necessity - because the range.interior.color property fails silently on merged cells.

We also have a second consideration: interior.color sometimes returns zero for cells with no interior colour. This is embarrassing when you've read the original colour as zero and 'restore' the range to that after flashing and ringing bells.

This is the code to flash a cell in red, three times (the default settings for 'WarningFlash'):
WarningFlash rngFileControl.Cells(iRow, iCol)
And this is what the code looks like to flash the cell (or merged cells) behind a command button, twice, in a tasteful yellow colour:
WarningFlash rngFileControl.Rows.Worksheet.OLEObjects("cmdSelectFiles").TopLeftCell, &HFFFF, 2
Note that we select the top-left cell of the range: my code for merged ranges only works if you specify the whole of the merge, or the first cell in the merge. And yes, I often put COM control buttons in merged cells: a well-formatted button with a 16*16 icon is twice the height of a standard Excel row, and I prefer to have the control in a merged single cell because 'move and size with cells' works badly if the control spans more than one cell.

Coding Note: best-practice would be to save your favourite colours as constants, or to use the built-in VBA colour constant for yellow: VBA.ColorConstants.vbYellow

So, without further ado, the source for the WarningFlash subroutine:
Public Sub WarningFlash(FlashRange As Excel.Range, _ 
                         Optional WarningColor As Long = &HFF, _ 
                         Optional FlashCount As Integer = 3)   Dim lngPriorColor As Long Dim i As Integer   Dim rng As Excel.Range       ' This unwieldly syntax works on ranges of merged cells, if you specify the top left cell     Set rng = FlashRange.Areas(1).Worksheet.Range(FlashRange.Areas(1).Address)       lngPriorColor = rng.Interior.Color     If lngPriorColor = 0 Then Exit Sub       For i = 1 To FlashCount         rng.Interior.Color = WarningColor         Sleep 500         rng.Interior.Color = lngPriorColor         Sleep 500     Next i   End Sub
And now for the difficult bit: I'm using 'sleep', because Application.Wait only works in whole seconds. That API declaration needs to work in all Windows versions, and in all versions of VBA:
 
#If VBA7 And Win64 Then    ' 64 bit Excel under 64-bit windows
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongLong)
#ElseIf VBA7 Then     ' 64 bit Excel in all environments
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else    ' 32 bit Excel
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If
Let me know how you get on: or, better still, post your own solutions.



Tuesday 30 August 2011

Demising VBA: the caret and stick approach

I haven't been posting much in the last year, because the work I'm doing is under contract and I don't own the source code... So I can't publish it here. I can't complain: everyone's tightened up the IP and disclosure rules in their contracts and workng quietly beats hell out of not working.

So, in the absence of any actual content from me, here's a little gem from Tushar Mehta, on VBA in Office 2010:


To support this new data type, Microsoft also introduced the CLngLng function, the VarType constant vbLongLong, and the DefType statement DefLngLng. The type declaration character is ^. This can cause problems while typing VBA statements that use the exponentiation operator, which is also ^.


Feel free to read the details... And remember to insert a space before indicating an exponent in your calculations.

I wonder what else is out there, waiting to be discovered. I wonder, also, whether any other financial institution has made the transition to Office 2010, outside of a few 'early adopters' who amuse and entertain their IT staff with their ingenuity. We've only got about 50,000 regular users, worldwide - regular as in 'I use it every day in a critical part of my job', and probably twice that number of occasionals, so we're talking about a fair chunk of revenue for Microsoft here, and you'd think they'd make it easy for us to migrate.

Actually, you know Microsoft: you know damn' well they've made it difficult.

Everything we've done in terms of macros and reports, all the way up to add-ins and fully-developed applications, will need some testing - that's standard for all Office upgrades, even service patches - and we test the complex ones quite thoroughly. You'd think there might be tools, and scripts, and maybe even checklists and case studies. But no: Microsoft is unlike any other software vendor. And we start this job *knowing* that everything we've build that uses the application menubar is broken, by design, by Microsoft's insistence on imposing the new 'Ribbon Bar' with no concession whatsoever to supporting backward compatibility... I predict thet we'll be using Office 2003 well into 2012; and that there are major companies as big as us, or bigger, who'll be using it in 2014.

Ultimately, Microsoft will kill off VBA and this is just another nail in the coffin; they are, if you will, putting the caret before the hearse.


Thursday 17 February 2011

Adding a month to the end of the month: another Excel annoyance

Ever see a column of month-end payment days do this in a spreadsheet?



 31/08/2005

 30/11/2005

 28/02/2006

 28/05/2006

 28/08/2006

 28/11/2006

 28/02/2007

 28/05/2007

 28/08/2007

 28/11/2007

 28/02/2008



Sigh. All VBA developers eventually face the weary task of correcting the VBA.DateTime function library because of this loathsome miscoding by Microsoft:




' Special handling required for adding months at EOM:

' VBA.DateAdd("m", 1, "28 Feb 2006") = 28/03/2006 (!)

' Business logic is ALWAYS that adding a month to EOM

' gives the end of the following month - 31 Mar 2006.






Here's my solution: I guess you've all got one of your own by now.



The usual health warning applies to ATTRIBUTE statements: they are not recognised by the VBA editor, you have to drag-and-drop the entire module out of the VB IDE, insert the statements manually in notepad, and drag the object back. In case you didn't know, the VB_ProcData attribute places AddDate in the 'Date & Time' category of the Spreadsheet Function Wizard, instead of letting it languish in obscurity under 'User-Defined'.






Public Function AddDate( _
        ByVal DateString As String, _
        Optional ByVal ReferenceDate As Date _
        Optional Subtract As Boolean = False _
        ) As Date

'ATTRIBUTE AddDate.VB_Description="Add a datestring of the form '1m', '10d' or '5y' to the reference date. \r\nBy default the reference date is the current date. \r\nInteger dates only: time expressed as fractional days is discarded. \r\nAll addition and subtraction uses Actual/Actual: no other date convention is implemented.

'ATTRIBUTE AddDate.VB_ProcData.VB_Invoke_Func = " \n2"




'Nigel Heffernan 2001 





'THIS CODE IS IN THE PUBLIC DOMAIN





'Add a datestring of the form '1m', '10d' or '5y' to the reference date.

'By default the reference date is the current date.

'Integer dates only: time expressed as fractional days is discarded.

'All addition and subtraction uses Actual/Actual: no other date convention is implemented.



Const VB_HELPFILE As String = "C:\PROGRA~1\COMMON~1\MICROS~1\VBA\VBA6\1033\VbLR6.chm"

' I'm too lazy to do the proper registry lookup for this help file.



On Error GoTo ErrSub



Dim sNum As String

Dim iLen As Integer

Dim i As Long

Dim strLabel As String



If ReferenceDate = 0 Then

    ReferenceDate = Date

End If





DateString = Trim(UCase(DateString))

DateString = Left(DateString, 16)



If DateString = "SPOT" Then



    DateString = "2" 'Spot price - 'zero-day' plus settlement lag

    strLabel = "d"

    

ElseIf DateString = "OVERNIGHT" Then



    DateString = "1"

    strLabel = "d"

    

ElseIf DateString = "O/N" Then



    DateString = "1"

    strLabel = "d"



ElseIf DateString = "DAILY" Then



    DateString = "1"

    strLabel = "d"



ElseIf DateString = "WEEKLY" Then



    DateString = "7"

    strLabel = "d"

    

ElseIf DateString = "ANNUAL" Then



    DateString = "1"

    strLabel = "yyyy"  ' Year



ElseIf DateString = "YEARLY" Then



    DateString = "1"

    strLabel = "yyyy"  ' Year



ElseIf DateString = "MONTHLY" Then



    DateString = "1"

    strLabel = "m"



ElseIf DateString = "QUARTERLY" Then



    DateString = "3"

    strLabel = "m"



ElseIf DateString = "SEMI-ANNUAL" Then



    DateString = "6"

    strLabel = "m"



ElseIf DateString = "SEMIANNUAL" Then



    DateString = "6"

    strLabel = "m"



ElseIf InStr(DateString, "MONTH") Then



    iLen = InStr(DateString, "M")

    strLabel = "m"      ' Month"



ElseIf InStr(DateString, "YEAR") Then



    iLen = InStr(DateString, "Y")

    strLabel = "yyyy"  ' Year"



ElseIf InStr(DateString, "DAY") Then



    iLen = InStr(DateString, "D")

    strLabel = "d"      ' Day"



ElseIf InStr(DateString, "M") Then



    iLen = InStr(DateString, "M")

    strLabel = "m"      ' Month"



ElseIf InStr(DateString, "Y") Then



    iLen = InStr(DateString, "Y")

    strLabel = "yyyy"  ' Year"



ElseIf InStr(DateString, "D") Then



    iLen = InStr(DateString, "D")

    strLabel = "d"      ' Day"



ElseIf InStr(DateString, "Q") Then



    iLen = InStr(DateString, "Q")

    strLabel = "q"      ' Quarter"



ElseIf InStr(DateString, "W") Then



    iLen = InStr(DateString, "W")

    strLabel = "ww"     ' Week"



ElseIf IsNumeric(DateString) Then



    iLen = Len(DateString)

    strLabel = "d"      ' Day"





Else



    GoTo ErrSub



End If





sNum = Trim(Left(DateString, iLen - 1))





If Not IsNumeric(sNum) Then



    'Trim down until we reach a number



    Do Until IsNumeric(sNum) Or Len(sNum) < 1



        sNum = Left(sNum, Len(sNum) - 1)

        sNum = Trim(sNum)



        'Do not read "5-Year" as "Minus five years"

        If Right(sNum, 1) = "-" Then

            sNum = Left(sNum, Len(sNum) - 1)

            sNum = Trim(sNum)

        End If



    Loop



End If



If Len(sNum) < 1 Then

    GoTo ErrSub

End If



If Not IsNumeric(sNum) Then

    GoTo ErrSub

End If



i = CLng(sNum)



If Subtract Then

    i = -1 * i

End If



' Special handling required for adding months at EOM:

' VBA.DateAdd("m", 1, "28 Feb 2006") = 28/03/2006 (!)

' Business logic is ALWAYS that adding a month to EOM

' gives the end of the following month - 31 Mar 2006.



If strLabel = "m" Then



    If Month(ReferenceDate) <> Month(ReferenceDate) + 1 Then 'EOM detected

        ReferenceDate = ReferenceDate + 1

        AddDate = DateAdd(strLabel, i, ReferenceDate)

        AddDate = AddDate - 1

    Else

        AddDate = DateAdd(strLabel, i, ReferenceDate)

    End If

    

Else



    AddDate = DateAdd(strLabel, i, ReferenceDate)

    

End If



ExitSub:

    Exit Function

    

ErrSub:



    If Len(Dir(VB_HELPFILE)) > 0 Then

        Err.Raise 13, "AddDate Function", _
         "'" & DateString & "'" & " was not recognised as date interval." & vbCrLf _
         & vbCrLf _
         & "Try typing '10d', '3m' or '5y', or the date " & vbCrLf _
         & "interval as a number of calendar days.", _
         VB_HELPFILE, 1000013

    Else

        Err.Raise 13, "AddDate Function", _
         "'" & DateString & "'" & " was not recognised as date interval." & vbCrLf _
         &  _
        vbCrLf _
         & "Try typing '10d', '3m' or '5y', or the date " &  _
        vbCrLf _
         & "interval as a number of calendar days."

    End If

        

End Function