Converting an Excel date into PHP timestamp

I was recently asked by a customer to upload a large dataset extracted from their old Microsoft Office based database system into their shiny new web-based application (Built by the guys at Zypher).

The data included a lot of date fields which needed to be converted into UNIX timestamp to be used by the PHP based front-end.

We used the formula below to convert the dates, it assumes the date is in cell ‘A2’.

=(A2-DATE(1970,1,1))*86400

I hope it proves useful.

Pasting formulas between workbooks without workbook link

Have you ever needed to copy and paste a range of cells containing formula, each referencing cells in other worksheets, from one workbook to another ?  When you copy the formula across workbooks, Excel, by default, copies a link from the original file.  So instead of copying “=Sheet2!D6+Sheet2!E6” you end up with =[YourOriginalFile.xls]Sheet2!D6+[YourOriginalFile.xls]Sheet2!E6.

This has always frustrated me, I can see why it would be useful, but wouldn’t it be nice to have a simple way of copying the formula without the original file name.

For a while now I’ve been using a fairly simple work-around, using Edit / Replace.

• Select the range you want to copy
• Edit->Replace
• What:= “=” (the equal sign)  /  With:=”^^” (or some unique string)
• Replace All

Now the formula are text strings, these can be copied and pasted without Excel doing anything to “help” you.

• Select the new range
• Edit->Replace
• What:= “^^” (or your unique string) / With:=”=” (equal sign)
• Replace All

Now the text strings are formulas again.  You will need to ensure you have matching worksheets in that new workbook, otherwise you’ll be dismissing lots of dialogs.

MemoryUsed Property

I'd never come across this before and it doesn't appear in the IntelliSense drop-down, but it is quite a neat way of monitoring the current workbook size.

Per the MSDN page here:

This example displays a message box showing the number of bytes that Microsoft Excel is currently using.

MsgBox "Microsoft Excel is currently using " _
                  Application.MemoryUsed & " bytes"

Find and replace VBA code using VBA

It is sometimes necessary to update your code, a quick find and replace (Ctrl+H) will often be enough.  I’d also recommend the MZ Tools VBE toolbar, it has a lot to add to your VBA coding experience, including a very good search tool.

Sometimes the above is not quite want you want.  So below is a simple bit of code you can use to replace one line of code for another.

Public Sub FindAndReplace()
'-----------------------------------------------------------------------------' Procedure : FindAndReplace
' Purpose   : Searches the active workbook for a specific code line and
'             replaces it with a new code line
'-----------------------------------------------------------------------------
    Dim SL As Long, EL As Long, SC As Long, EC As Long
    Dim S As String
    Dim Found As Boolean
    Dim sFind As String
    Dim sReplace As String

    sFind = "my old line of code"
    sReplace = "my new line of code"

    With ActiveWorkbook.VBProject.VBComponents("MyCodeModule").CodeModule
        SL = 1
        SC = 1
        EL = 99999
        EC = 999
        Found = .Find(sFind, SL, SC, EL, EC, True, False, False)
        If Found = True Then
            S = .Lines(SL, 1)
            S = Replace(S, sFind, sReplace)
            .ReplaceLine SL, S
        End If
    End With

End Sub

SL / SC is the start line / start column and EL / EC is the end line / end column.  These can be changed to target code lines within a specific part of your code.

I hope the above proves useful.  As always, any questions let us know via the comments.

Checking odd and even numbers in VBA

It is sometimes useful to be able to check whether a number is odd or even.

Below is a very simple VBA function that does exactly that:

Function IsOdd(x As Integer) As Boolean
'------------------------------------------------------------------------
' Procedure : IsOdd
' Author : Zypher.co.uk
' Date : 09-Feb-2012
' Purpose : Check whether a value is odd or even
'------------------------------------------------------------------------
   IsOdd = (x Mod 2) <> 0
End Function

As always, I hope it proves useful.

Autofilter on a protected worksheet

You will quite probably have come across this problem already.  You need to protect the data in a worksheet for any number of reasons, but the recipient of the report wants to be able to use autofilter.
I've had this code for a while, but only recently needed it again, which reminded me to put it up here.

It's a very simple piece of code.  The code below applies a password to a worksheet, but leaves autofilter available.

   With Worksheets("YourWorkSheet")
      EnableAutoFilter = True
      Protect Password:="123", Contents:=True, UserInterfaceOnly:=True
   End With

As always, hope it proves useful.

Creating and reading data from text files

It is sometimes useful to keep data in a text file.  For example one of our clients has a resource file which has onOpen and onClose routines that log the current user, the date and time and whether the file was opened read/write or read only.

The code below shows how this can be done.

Sub Create_A_File()
' Put data into a text file
' This routine will create the file if it does not already exist

    Dim strMsg  As String
    Dim strFile As String

    strFile = ThisWorkbook.Path & "myFile.txt"
    ' could be .doc, .txt, .log etc

    strMsg = "Some text could go here"

    ' Open file for output - clears any current data
    'Open strFile For Output As #1
    ' or Open file for append - updates any current data
    Open strFile For Append As #1

    Print #1,                       ' Print blank line to file.
    Print #1, "*****"               ' Print ***** line to file.
    Print #1, strMsg                ' Print a variables value to the text file
    Print #1, Now, strMsg           ' Print date/time and the message, using commas create tab seperated data
    Print #1,                       ' Print another blank line to file.
    Print #1, Application.UserName  ' Print the current user's Excel username
    Print #1, Now                   ' Print the date and time

    Close #1                        ' Close file.

End Sub

Sub GetFromTxt()
' Copy data from one text file to another

    Dim FilePath    As String
    Dim File1       As String
    Dim File2       As String
    Dim File3       As String
    Dim FileData    As String

    Const FileExt   As String = ".txt"

    FilePath = "C:\File\Path\"
    File1 = "File Name 1"
    File2 = "File Name 2"
    File3 = "File Name 3"

    ' Example: FilePath & File1 & FileExt = "C:\File\Path\File Name 1.txt"

    'Open all relevant files
    Open FilePath & File1 & FileExt For Output As #1
    Open FilePath & File2 & FileExt For Input As #2
    Open FilePath & File3 & FileExt For Input As #3

    'Copy each line of the first existing file into the
    'new combined file
    Do While Not EOF(2)
        Input #2, FileData
        Print #1, FileData
    Loop

    'Copy each line of the second existing file into the
    'new combined file
    Do While Not EOF(3)
        Input #3, FileData
        Print #1, FileData
    Loop

    'Close all files
    Close #1
    Close #2
    Close #3
End Sub

Hope that proves useful.

Useful VBA file functions - Microsoft Scripting Runtime

Some example functions for finding out the last modified date of a file, copying a file and deleting a file using VBA.

Public Sub File_Last_Modified_Date()
' Use a function to return the last modified date of a file
    MsgBox f_File_Last_Modified_Date("C:\Put\the\full\file\address\here.xlsx")
End Sub

Private Function f_File_Last_Modified_Date(FileName As String) As String
' In the VBE, set a reference to Microsoft Scripting runtime
' Tools -> References... ->
    Dim fso As Scripting.FileSystemObject
    Dim fsof As Scripting.File
    Dim strPath As String

    Set fso = New FileSystemObject
    strPath = FileName
    Set fsof = fso.GetFile(strPath)
    With fsof
        f_File_Last_Modified_Date = .DateLastModified
    End With

    Set fso = Nothing
    Set fsof = Nothing
End Function

---

Public Sub CopyFile()
' Copy a file, the file cannot be open when the copy is attempted

    Dim SourceFile As String
    Dim DestFile As String

    SourceFile = "C:\Put\the\full\file\address\here.doc"
    DestFile = "C:\Put\the\new\file\address\here.doc"

    FileCopy SourceFile, DestFile
End Sub

Public Sub DeleteFile()
' Delete a file

    Dim FileName As String

    FileName = "C:\Put\the\full\file\address\here.txt"

    ' Check the file exists
    If Dir(FileName) = "" Then
        ' File does not exist
    Else
        ' Delete the file
        Kill FileName
    End If

End Sub

As always, any questions or comments please let us know via the comments section.

“Code execution has been interrupted”

Every now and then, while executing macro routines within Excel you may get the error message “code execution has been interrupted”.  This error message should only appear if you hit “Ctrl+Break” to stop the execution and view the code. But… sometimes it just happens, normally with no apparent reason.

If you hit the “Continue” button, the code will execute for a while, and may even finish, but you may get the same error message again. Sometimes you may even have to click the “continue” button several times to complete the execution of a macro.

This issue caused intermittent problems for me over a long period of time, that was until I found the solution.

To stop this, often re-occurring, problem all you have to do is add one line of code “Application.EnableCancelKey = xlDisabled” as the first line of your macro.

This should fix the problem and enable you to execute your macro code successfully without getting the dreaded error message “Code execution has been interrupted” again.

The above fix is fine for any projects being rolled out to a group of users. If you’re testing code and using “Ctrl+Break” this might be a hindrance. Another fix is, while In the debug window, press Ctrl+Break, this again fixes the issue.

Of course, the next time you press “Ctrl+Break” in the Excel window the problem may well come back!

I say should because this is not guaranteed :( I have had occasions when this does not work, rebooting the PC is the only other possible solution I’ve found.

Compile Error: "Object Library Invalid..."

If you’ve ever come across the ‘Compile Error’ message you’ll know how much fun they can be to correct. 

Quite often when this message appears you’ll find yourself faced with the VBE telling you that ‘Left’ is not a valid function !  The first thing you should check is what references you are using.  If you’ve ever written some code on one version of Excel and tried to role it out to users with an older version you’ll have seen this many times. 

When you add references in an Excel 97 file and use it in Excel 2003 the references will automatically update.  If you try and do that the other way round the references do not ‘back-date’.  You’ll need to go to the references box and un-check the ‘Missing’ reference.  Then look through the list and find the older version which is available to the Excel version you are using.

The most recent one I found displayed the following message:

Object Library Invalid or Contains References to Object Definitions that could not be found.

I’ll add here that I was working in an office which predominately used Excel 97 with several PCs with Excel 2003.  A little retro there ;)

The error occurred in Excel 2003 using an Add-In (.xla) created in Excel 2003 !  I checked for missing references and found none.  The file opened and the code ran without issue on other machines, both Excel 97 and Excel 2003. 

After turning to Google I found this thread at ozgrid.com.  The answer; deleting the all the EXD files left by previous iterations of the project. EXD files cache ActiveX component information. If the component changes without removing the EXD file (which is created when the component is first used), then the system will be out of sync. 

To delete the EXD files go to command prompt and type the following DOS commands:

• > CD \Document and Settings
• > DEL /S /A:H /A:-H *.EXD

To explain what that does I’ll quote from the thread:

Essentially the command recursively deletes all your hidden and exposed exds. That will make all your ActiveX components load a bit slower the first time you use them again, but it should also clear out the problematic ones.

So, I’ll keep my fingers crossed that the above works for you too.

Using VBA to Convert a Column Number To A Letter

Sometimes while manipulating data in Excel you’ll have a integer which represents the column number, but need the column letter.

The function below can translate that number to the column letter required.  This function has been tested and works to 702, column ‘ZZ’.

Function ConvertToLetter(iCol As Integer) As String
'-----------------------------------------------------------------------------
' Procedure : ConvertToLetter
' Author    : Niall - Zypher.co.uk
' Purpose   : Convert a number to a column letter
'             Tested to 256 columns, assumed to work until 702 (ZZ)
'-----------------------------------------------------------------------------
'
    If iCol <= 26 Then
        ' Columns A-Z
        ConvertToLetter = Chr(iCol + 64)
    Else
        ConvertToLetter = Chr(Int((iCol - 1) / 26) + 64) & _
                          Chr(((iCol - 1) Mod 26) + 65)
    End If
End Function

As always, any questions or enquiries let us know via the comments section.

Add worksheets to Excel using VBA

Adding worksheets to Excel is quite simple. For example, to add a Worksheet before the active sheet (default unless stated otherwise), name it "MyWorksheet" and have it become the active sheet, you would use code similar to below;

Sub Add_New_Worksheet()
    ' Add a new worksheet in front of the active sheet
    Worksheets.Add().Name = "MyWorksheet"
End Sub

If we want to add a new Worksheet as the last Worksheet in the active workbook and name it "MyWorksheet" we would use;

Sub Add_As_Last_Worksheet()
    ' A a named worksheet to the end
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "MyWorksheet"
End Sub

The Add Method (with regards to the Worksheet Object) has an After Variant as well as an Before Variant. You can only use one of the options, either the Before or After Variant, or omit the Argument altogether. If we do omit the Before and After Variants Excel places the Worksheet before the current active Sheet.

the example below shows how to add more then one Worksheet, the code below adds 2 new worksheets;

Sub Add_n_Worksheets()
    ' Insert 2 worksheets after the last current worksheet
    Worksheets.Add After:=Worksheets(Worksheets.Count), Count:=2
End Sub

The last Variant available is the Type Variant. The Type specifies the sheet type. The choices available are listed below;
XlSheetType constants:

• xlWorksheet
• xlChart
• xlExcel4MacroSheet
• xlExcel4IntlMacroSheet

If you are inserting a sheet based on an existing template, specify the path to the template (Recording a macro is best for this). The default value is xlWorksheet.

Create a Microsoft Word Document with VBA

The below code is a basic example on how to create a Microsoft Word document.  This is sometimes useful if want to create a report showing your data outside of Excel.

Private Sub CreateWordDoc()
'-----------------------------------------------------------------------------
' Procedure : CreateWordDoc
' Author    : Matthew - Zypher.co.uk
' Date      : 12/04/2007
' Purpose   : Create a MS Word document using earling binding
'             Requires a reference to 'Microsoft Word ??.? Object Library'
'-----------------------------------------------------------------------------
'
    Dim objWord As Word.Application
    Dim doc As Word.Document

    'Create Word doc object
    Set objWord = CreateObject("Word.Application")

    With objWord
        ' Ensure the MS Word object is visible
        .Visible = True

        ' Add a new word document and save the file prior to adding text
        Set doc = .Documents.Add
        doc.SaveAs "C:\Your\File\Directory\Filename.doc(x)"

        ' Or open an existing document
        'Set doc = wrdApp.Documents.Open("C:\Foldername\Filename.doc")
    End With

    'Construct document
    With objWord.Selection
        ' Set the font type
        .Font.Name = "Trebuchet MS"
        ' Set the font size
        .Font.Size = 16

        ' Set the format, depending on the value of i
        For i = 1 To 50
            Select Case i
                Case Is < 10
                    ' Set the font size
                    .Font.Size = 12
                    ' Set font to bold
                    .Font.Bold = True
                    ' Align the text to the right of the page
                    .ParagraphFormat.Alignment = wdAlignParagraphRight

                Case Is < 20
                    ' Set the font size
                    .Font.Size = 8
                    ' Turn off bold
                    .Font.Bold = False
                    ' Align the text to the right of the page
                    .ParagraphFormat.Alignment = wdAlignParagraphLeft

                Case Is < 30
                    ' Set the font size
                    .Font.Size = 10
                    ' Turn on bold
                    .Font.Bold = True
                    ' Align the text to the right of the page
                    .ParagraphFormat.Alignment = wdAlignParagraphRight

                Case Is < 40
                    ' Set the font size
                    .Font.Size = 6
                    ' Turn off bold
                    .Font.Bold = False
                    ' Align the text to the center
                    .ParagraphFormat.Alignment = wdAlignParagraphCenter

                Case Else
                    ' do nothing
            End Select

            ' Add text
            .TypeText "Here is an example test line, #" & i _
                & " - Font size is " & .Font.Size
            ' Move to the next line
            .TypeParagraph

        Next i

    End With

    ' Save the file
    doc.Save
    ' Bring the MS Word window to the front
    doc.Activate

End Sub

As always, if you have any questions do let us know.

VBA Array Within An Array

When using VBA, writing anything but the most trivial VBA routines, it is likely that you’ll be using arrays somewhere in your code. This post describes how you can load one array to another and then pull the data out into a worksheet.
It is assumed that you know the basics of VBA arrays.
Sub ArrayWithinAnArray() 
'----------------------------------------------------------------------------
' Procedure : ArrayWithinAnArray
' Author    : Matthew - Zypher.co.uk
' Date      : 27/03/2011
' Purpose   : Load an ID, a data value and an array to an array
'             Then loop through the 1st array loading it’s values to the
'             active worksheet
'----------------------------------------------------------------------------
'     Dim i As Integer
    Dim l As Integer
    Dim x As Integer
    Dim y As Integer

    Dim array1(2, 2) As Variant
    Dim array2(1, 1) As Variant

    On Error GoTo ArrayWithinAnArray_Error

    ' Add values into the 1st array
    For i = 0 To 2
        array1(i, 0) = "ID " & i
        array1(i, 1) = "Some Data"

        ' Load values to the 2nd array
        array2(0, 0) = "row1 col1"
        array2(0, 1) = "row1 col2"
        array2(1, 0) = "row2 col1"
        array2(1, 1) = "row2 col2"

        ' Load the 2nd array into the 1st array
        array1(i, 2) = array2
    Next i

    ' Set l as the first row
    l = Cells.SpecialCells(xlCellTypeLastCell).Row + 1

    ' Loop through the first array
    For i = 0 To UBound(array1)
        Cells(l, 1).Value = array1(i, 0)
        Cells(l, 2).Value = array1(i, 1)

        ' Check the 3rd value is an array
        If IsArray(array1(i, 2)) Then

            ' Loop down through the 2nd array
            For x = 0 To UBound(array1(i, 2))

                ' Loop across the 2nd array
                For y = 0 To UBound(array1(i, 2), 2)

                    ' Load the values in the 2nd array to the worksheet
                    Cells(l, y + 3).Value = array1(i, 2)(x, y)

                Next y

                ' Get the current bottom row, then add 1
                l = Cells.SpecialCells(xlCellTypeLastCell).Row + 1
            Next x

        End If

        ' Get the current bottom row, then add 1
        l = Cells.SpecialCells(xlCellTypeLastCell).Row + 1

    Next i

    On Error GoTo 0
    Exit Sub

ArrayWithinAnArray_Error:
    ' Add some error handling code here
End Sub
As always, if you have any questions do let us know via the comments section.

April Fools Reverse The Excel Menu with VBA

The code below will, when run, reverse all of the menus and their options within Excel.  For example; File will become Elif and Tools will become Sloot.  It works on Excel 97 through 2003.  Simply run the code again to ‘reverse’ the name back to their original format.  It is worth noting that Excel remembers the settings, so you will need to be able to re-run the code.

Sub ReverseMenuText()
    Dim m1 As CommandBarControl
    Dim m2 As CommandBarControl
    Dim m3 As CommandBarControl

    On Error Resume Next
    For Each m1 In Application.CommandBars(1).Controls
        m1.Caption = Reverse(m1.Caption)
        For Each m2 In m1.Controls
            m2.Caption = Reverse(m2.Caption)
            For Each m3 In m2.Controls
                m3.Caption = Reverse(m3.Caption)
            Next m3
        Next m2
    Next m1
End Sub


Function Reverse(MenuText As String) As String
    Dim Temp As String, Temp2 As String
    Dim ItemLen As Integer, i As Integer
    Dim HotKey As String * 1
    Dim Found As Boolean

    ItemLen = Len(MenuText)
    Temp = ""
    For i = ItemLen To 1 Step -1
        If Mid(MenuText, i, 1) = "&" Then _
            HotKey = Mid(MenuText, i + 1, 1) _
        Else Temp = Temp & Mid(MenuText, i, 1)
    Next i
    Temp = Application.Proper(Temp)
    Found = False
    Temp2 = ""
    For i = 1 To ItemLen - 1
        If UCase(Mid(Temp, i, 1)) = UCase(HotKey) And Not Found Then
            Temp2 = Temp2 & "&"
            Found = True
        End If
        Temp2 = Temp2 & Mid(Temp, i, 1)
    Next i
    If Left(Temp2, 3) = "..." Then Temp2 = Right(Temp2, ItemLen - 3) & "..."
    Reverse = Temp2
End Function

This code was orinally found on MrExcel.com.

Aprils Fools ‘Quit Excel’ Workbook_Open Event :)

I just came across this Aprils Fools trick while looking through some old code files.  Figured as it’s the right time of year I’d post it.  Put this code in the ‘ThisWorkbook’ code module, save the file and wait for the users to shout ;)

Private Sub Workbook_Open()
'-------------------------------------------------------------------------
' Procedure : Workbook_Open
' Author    : Matthew Sims - Zypher.co.uk
' Date      : 01/03/2005
' Purpose   : To annoy ;)
'             Quit Excel 30 times out of 100 when the user opens this file
'-------------------------------------------------------------------------
'
    ' Set the annoying level (percentage chance that Exel will close)
    Const annoying_level As Long = 30
    Dim annoying_number As Long

    Application.DisplayAlerts = False

    Randomize
    annoying_number = 100 * Rnd

    ' If the randomly chosen 'annoying_number' is lower then the
    ' preset 'annoying_level' then quite Excel
    If annoying_number < annoying_level Then
        ' Quit Excel
        Application.Quit
    End If

End Sub

Using VBA to Truncate Decimal Values

Recently I have needed to truncate a decimal value to a set number of decimal places. 

For example; If you wanted the number 55.446 to two decimal places rounding the number would return 55.45.  Truncating the number to two decimal places returns 55.44. 

To do this I created the function below.  Pass in a decimal value and the number of decimal places you want the number truncated too and the function returns the value as a ‘Double’.

Public Function TruncTo(dblValue As Double, lngPlaces As Long) As Double
'-------------------------------------------------------------------------
' Procedure : TruncTo
' Author    : Matthew Sims
' Date      : 08-Oct-2010
' Purpose   : Truncate a decimal value to the requested number of decimal places
'-------------------------------------------------------------------------
'
    On Error GoTo TruncTo_Error

    If IsNumeric(dblValue) Then
        TruncTo = Int(dblValue * 10 ^ lngPlaces) / 10 ^ lngPlaces
    Else
        TruncTo = 0
    End If

    On Error GoTo 0
    Exit Function

TruncTo_Error:
    ' Add some error handling code here
End Function

VBA Adjusting Speaker Volume (and Mute)

Following on from the code here (Using VBA Speech) the code below is used to make adjust the speaker volume, including turning mute on / off.

Private Declare Sub keybd_event Lib "user32" ( _
   ByVal bVk As Byte, ByVal bScan As Byte, _
   ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Sub VolUp()
'-- Turn volumn up --
   keybd_event VK_VOLUME_UP, 0, 1, 0
   keybd_event VK_VOLUME_UP, 0, 3, 0
End Sub

Sub VolDown()
'-- Turn volumn down --
   keybd_event VK_VOLUME_DOWN, 0, 1, 0
   keybd_event VK_VOLUME_DOWN, 0, 3, 0
End Sub

Sub VolToggle()
'-- Toggle mute on / off --
   keybd_event VK_VOLUME_MUTE, 0, 1, 0
End Sub

Again, this requires the PC to a sound card and speakers.

Using VBA Speech

With April Fools day approaching (well, four weeks) I though I’d post a couple of amusing VBA tricks and jokes you could use.  The first is using the speech and the CD trey.  The code below can be copied straight into a VBA code module.

Declare Sub mciSendStringA Lib "winmm.dll" (ByVal lpstrCommand As String, _
ByVal lpstrReturnString As Any, ByVal uReturnLength As Long, _
ByVal hwndCallback As Long)

Private Sub Workbook_Open()
    UseSpeech "The Mouse is hungry."
    OpenCDTray
    UseSpeech "Please add cheese."
    CloseCDTray
End Sub

Private Sub OpenCDTray()
    mciSendStringA "Set CDAudio Door Open", 0&, 0, 0
End Sub

Private Sub UseSpeech(stringToSpeak As String)
    Range("A1").Value = stringToSpeak
    Range("A1").Speak
    Application.CommandBars("Text To Speech").Visible = False
End Sub

Private Sub CloseCDTray()
    mciSendStringA "Set CDAudio Door Closed", 0&, 0, 0
End Sub

This does require the PC to have speakers.

VBA Version Property

It is sometimes useful to know which version of Excel your user is using.  An example of when this would be useful is knowing whether the user is in Excel 2007/2010 or and older version.  Excel 2007 was the first release that allowed over 65535 rows and 255 columns.  Excel 2007 has over 1 million rows (1048576) and 16384 columns.

This can make a big difference to what you can do with the data available to you.  If your user is in Excel 2003 for example your code could crash if it attempts to copy too much data into the active workbook.  The function below can be used within your code to confirm the Excel version, you can then call a different routine depending on it’s results.

Private Function ReturnExcelVersion() As String
'-----------------------------------------------------------------
' Procedure : ReturnExcelVersion
' Author    : Matthew - Zypher.co.uk
' Purpose   : return a string value denoting the version of Excel
'             Check the first two characters as Excel 97 has
'             several different releases and patches
'             http://support.microsoft.com/kb/232652
'-----------------------------------------------------------------
'
    Select Case Left(Application.Version, 2)

         Case Is = "14"
            ReturnExcelVersion = "2010" 
        Case Is = "12"
            ReturnExcelVersion = "2007"
        Case Is = "11"
            ReturnExcelVersion = "2003"
        Case Is = "10"
            ReturnExcelVersion = "2002"
        Case Is = "9."
            ReturnExcelVersion = "2000"
        Case Is = "8."
            ReturnExcelVersion = "97"
        Case Is = "7."
            ReturnExcelVersion = "95"
        Case Else
            ReturnExcelVersion = "Unknown"
    End Select
End Function

Excel 2010 is version 14. The version number 13 was skipped because of the aversion to the number 13.  Another relevant link is XL97: Overview and History of Excel Patches.

You may also want to look into Application.OperatingSystem.

As always, if you have any questions do let us know via the comments section.