Playing A Sound Based On A Cell’s Value

Category: VBA Functions | [Item URL]

Some people like audio feedback. For example, you might want to hear a sound when the value in a particular cell exceeds a certain value. Excel does not support this feature, but it's fairly easy to implement with a custom worksheet function that uses a Windows API function.

The Alarm function

Copy the code below to a VBA module in your workbook.

'Windows API function declaration
Private Declare Function PlaySound Lib "winmm.dll" _
  Alias "PlaySoundA" (ByVal lpszName As String, _
  ByVal hModule As Long, ByVal dwFlags As Long) As Long

Function Alarm(Cell, Condition)
    Dim WAVFile As String
    Const SND_ASYNC = &H1
    Const SND_FILENAME = &H20000
    On Error GoTo ErrHandler
    If Evaluate(Cell.Value & Condition) Then
        WAVFile = ThisWorkbook.Path & "\sound.wav" 'Edit this statement
        Call PlaySound(WAVFile, 0&, SND_ASYNC Or SND_FILENAME)
        Alarm = True
        Exit Function
    End If
ErrHandler:
    Alarm = False
End Function

NOTE: The Alarm function expects a WAV file (named sound.wav) in the same path as the workbook. You will need to change this statement to match the name (and path) of your actual sound file. If the sound file is not found, the default system sound will be used.

Using the Alarm function in a formula

The Alarm function monitors a cell for a specified condition. If the condition is met, the sound file is played and the function returns TRUE. If the condition is not met, the sound file is not played and the function returns FALSE. The Alarm function takes two arguments:

• Cell: A reference to a single cell (the cell that you are monitoring). Normally, this will be a cell that contains a formula (but that is not required).
• Condition: A text string that describes the condition

Following are examples of formulas that use this function:

=Alarm(A1,">=1000")

The sound will play when the value in cell A1 is greater than or equal to 1,000.

=Alarm(C12,"<0")

The sound will play when the value in cell C12 is negative.

Tips

• The function is evaluated whenever any cell that depends on the reference cell is changed. The sound can get annoying!
• Normally, you will want to use this function in only one cell. If you use it in more than one cell, you will not be able to tell which instance of the function triggered the sound.

Determining The Drive Type

Category: VBA Functions | [Item URL]

A companion file is available: Click here to download

This tip contains a VBA function that uses the Windows GetDriveType API function to determine the type of a particular drive.

Private Declare Function GetDriveType Lib "kernel32" _
  Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Function DriveType(DriveLetter As String) As String
'  Returns a string that describes the type of drive of DriveLetter
   DriveLetter = Left(DriveLetter, 1) & ":\"
   Select Case GetDriveType(DriveLetter)
      Case 0: DriveType = "Unknown"
      Case 1: DriveType = "Non-existent"
      Case 2: DriveType = "Removable drive"
      Case 3: DriveType = "Fixed drive"
      Case 4: DriveType = "Network drive"
      Case 5: DriveType = "CD-ROM drive"
      Case 6: DriveType = "RAM disk"
      Case Else: DriveType = "Unknown drive type"
  End Select
End Function

The function accepts a drive letter, and returns a string that describes the type of drive. Network drives must be mapped to a single-letter drive designator.

Example

The example below lists all drives, and their type. The information is sent to columns A and B of the active worksheet.

Sub ShowAllDrives()
    Dim LetterCode As Long
    Dim Row As Long
    Dim DT As String
    Row = 1
    For LetterCode = 65 To 90 ' A-Z
        DT = DriveType(Chr(LetterCode))
        If DT <> "Non-existent" Then
            Cells(Row, 1) = Chr(LetterCode) & ":\"
            Cells(Row, 2) = DT
            Row = Row + 1
        End If
    Next LetterCode
End Sub

The downloadable file also contains functions that return the total drive size, and space available.

The Versatile Split Function

Category: VBA Functions | [Item URL]

VBA's Split function, introduced with Excel 2000, can simplify many programming tasks. This function accepts a text string, and returns a zero-based variant array that contains the elements of the string (you specify the character that delimits the elements).

A simple example

The procedure below demonstrates how the Split function works.

Sub SplitDemo()
    Dim txt As String
    Dim x As Variant
    Dim i As Long
    txt = "The Split function is versatile"
    x = Split(txt, " ")
    For i = 0 To UBound(x)
       Debug.Print x(i)
    Next i
End Sub

This procedures displays the output shown below.

In this case, the delimiter is a space character. You can specify any character or string to be used as the delimiter. The following examples demonstrate some other uses for the Split function.

Extracting an element

Split is a VBA function, so it can't be used in a worksheet formula. The function below is simply a "wrapper" for the Split function, so your formulas can make use of this handy function.

Function ExtractElement(str, n, sepChar)

'   Returns the nth element from a string,
'   using a specified separator character
    Dim x As Variant
    x = Split(str, sepChar)
    If n > 0 And n - 1 <= UBound(x) Then
       ExtractElement = x(n - 1)
    Else
        ExtractElement = ""
    End If
End Function

The formula below demonstrates how the ExtractElement function can be used in a formula.

  =ExtractElement("546-339-909-944",3,"-")

This formula returns 909, the third element in the string (which uses a "-" as the delimiter).

Counting words

The function below returns the number of words in a string. It uses Excel's TRIM function to remove excess spaces (which would cause an incorrect result).

Function WordCount(txt) As Long
'   Returns the number of words in a string
    Dim x As Variant
    txt = Application.Trim(txt)
    x = Split(txt, " ")
    WordCount = UBound(x) + 1
End Function

Splitting up a filename

The two examples in this section make it easy to extract a path or a filename from a full filespec, such as "c:\files\workbooks\archives\budget98.xls"

Function ExtractFileName(filespec) As String
'   Returns a filename from a filespec
    Dim x As Variant
    x = Split(filespec, Application.PathSeparator)
    ExtractFileName = x(UBound(x))
End Function

Function ExtractPathName(filespec) As String
'   Returns the path from a filespec
    Dim x As Variant
    x = Split(filespec, Application.PathSeparator)
    ReDim Preserve x(0 To UBound(x) - 1)
    ExtractPathName = Join(x, Application.PathSeparator) & _
      Application.PathSeparator
End Function

Using the filespec shown above as the argument, ExtractFileName returns "budget98.xls" and ExtractPathName returns "c:\files\workbooks\archives\"

Counting specific characters in a string

The function below accepts a string and a substring as arguments, and returns the number of times the substring is contained in the string.

Function CountOccurrences(str, substring) As Long
'   Returns the number of times substring appears in str
    Dim x As Variant
    x = Split(str, substring)
    CountOccurrences = UBound(x)
End Function

Finding the longest word

The function below accepts a sentence, and returns the longest word in the sentence.

Function LongestWord(str) As String
' Returns the longest word in a string of words
    Dim x As Variant
    Dim i As Long
    str = Application.Trim(str)
    x = Split(str, " ")
    LongestWord = x(0)
    For i = 1 To UBound(x)
        If Len(x(i)) > Len(LongestWord) Then
            LongestWord = x(i)
        End If
    Next i
End Function

Retrieving The Computer Name Or Logged-in User Name

Category: VBA Functions | [Item URL]

This tip uses two Windows API functions to return the name of the computer, and the name of the user who is currently logged in. These functions can be used in a worksheet formula, or called from a VBA procedure.

NOTE: The logged-in user name may or may not be the name that is returned by Application.User

API Declarations

Private Declare Function GetComputerName Lib "kernel32" _
  Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) _
  As Long

Private Declare Function GetUserName Lib "advapi32.dll" _
Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) _
  As Long

The Functions

Public Function NameOfComputer()
'   Returns the name of the computer
    Dim ComputerName As String
    Dim ComputerNameLen As Long
    Dim Result As Long
    ComputerNameLen = 256
    ComputerName = Space(ComputerNameLen)
    Result = GetComputerName(ComputerName, ComputerNameLen)
    If Result <> 0 Then
        NameOfComputer = Left(ComputerName, ComputerNameLen)
    Else
        NameOfComputer = "Unknown"
    End If
End Function

Function UserName() As String
'   Returns the name of the logged-in user
    Dim Buffer As String * 100
    Dim BuffLen As Long
    BuffLen = 100
    GetUserName Buffer, BuffLen
    UserName = Left(Buffer, BuffLen - 1)
End Function

Identifying The Newest File In A Directory

Category: VBA Functions | [Item URL]

The VBA function listed below (two versions) returns the name of the most recent file in a directory. The function takes two arguments:

• Directory: The full path of the directory (String). For example, "c:\files\excel\"
• FileSpec: The file specification (String). For example, "*.xls" for Excel workbooks, or "*.*" for all files.

If the directory does not exist, or if it contains no matching files, the function returns an empty string.

Method 1: Using the Dir function

This function uses VBA's Dir function to get the file names. Use this function for maximum compatibility with older versions of Excel.

Function NewestFile(Directory, FileSpec)
' Returns the name of the most recent file in a Directory
' That matches the FileSpec (e.g., "*.xls").
' Returns an empty string if the directory does not exist or
' it contains no matching files
    Dim FileName As String
    Dim MostRecentFile As String
    Dim MostRecentDate As Date
    If Right(Directory, 1) <> "\" Then Directory = Directory & "\"

    FileName = Dir(Directory & FileSpec, 0)
    If FileName <> "" Then
        MostRecentFile = FileName
        MostRecentDate = FileDateTime(Directory & FileName)
        Do While FileName <> ""
            If FileDateTime(Directory & FileName) > MostRecentDate Then
                 MostRecentFile = FileName
                 MostRecentDate = FileDateTime(Directory & FileName)
             End If
             FileName = Dir
        Loop
    End If
    NewestFile = MostRecentFile
End Function

Method 2: Using the FileSearch object

This function uses the FileSearch object, which is not supported in all versions of Excel. Unlike the previous version of the function, this one returns the full path as well as the file name.

Also, be aware that the FileSearch object was removed, beginning with Office 2007.

Function NewestFile(Directory, FileSpec)

' Returns the full path and name of the most recent file in a Directory
' That matches the FileSpec (e.g., "*.xls").
' Returns an empty string if the directory does not exist or
' it contains no matching files
    Dim NumFound As Long
    NewestFile = ""
    With Application.FileSearch
        .NewSearch
        .LookIn = Directory
        .FileName = FileSpec
        NumFound = .Execute(SortBy:=msoSortByLastModified, _
            SortOrder:=msoSortOrderDescending)
        If NumFound > 0 Then NewestFile = .FoundFiles(1)
    End With
End Function

Usage Examples

This function can be called from a VBA procedure, or used in a worksheet formula. The statement below displays the name of the most recent Excel file in c:\myfiles\.

    MsgBox NewestFile("c:\myfiles", "*.xls")

The worksheet formula below displays the same filename.

    =NewestFile("c:\myfiles", "*.xls")

Removing Or Avoiding Automatic Hyperlinks

Category: Formatting / VBA Functions | [Item URL]

You may have discovered that Excel 2000 (and later versions) supports automatic cell hyperlinks. Whenever you type something that resembles a URL or an e-mail address into a cell, this feature automatically converts the text into a clickable hyperlink. But what if you don't want to create a hyperlink?

If you use Excel 2000, you're out of luck. There is no way to turn this potentially annoying feature off. But you can, however, override it. If Excel creates a hyperlink from your cell entry, click the Undo button (or press Ctrl-Z) to restore the cell's contents to normal text. Or, you can precede the cell entry with an apostrophe.

Note: If you're using Excel 2002 or later, you can turn automatic hyperlinks on or off in the AutoCorrect dialog box

Surprisingly, Excel doesn't provide a direct way to remove all hyperlinks on a worksheet. In fact, the only way to accomplish this is one cell at a time: Activate the cell that contains the hyperlink, right-click, and then select Hyperlink, Remove Hyperlink. Unfortunately, this command is available only when you have selected a single cell. To quickly deactivate all hyperlinks, you need to use a macro.

To create the macro, press Alt-F11 to activate the Visual Basic Editor, select Insert, Module to insert a new VBA module into your project, and then enter the following code:

Sub ZapHyperlinks() 
    Cells.Hyperlinks.Delete
End Sub

When you execute the ZapHyperlinks macro, all hyperlinks on the active sheet are deleted and replaced with normal text.

Developer FAQ - Functions

Category: General VBA / VBA Functions | [Item URL]

Note: This document was written for Excel 97 - 2000.

I created a custom worksheet function. When I access this function using the Insert Function dialog, it says Choose the Help button for help on this function and its arguments. How can I get Insert Function dialog box to display a description of my function?

As you discovered the message displayed in the Insert Function dialog box is erroneous and and misleading. To add a description for your custom function, select Tool - Macro - Macros to display the Macro dialog box. Your function won't be listed, so you must type it manually into the Macro name box. After typing the function's name, click Options to display the Macro Options dialog box. Enter the descriptive text in the Description box.

Can I also display help for the arguments for my custom function in the Paste Function dialog box?

Unfortunately, no.

My custom worksheet function appears in the User Defined category in the Insert Function dialog box. How can I make my function appear in a different function category?

You need to do this using VBA. The statement below assigns the function named MyFunc to category 1 (Finanacial)

Application.MacroOptions Macro:="MyFunc", Category:=1

The table below lists the valid function category numbers.

0. No category (appears only in All)
1. Financial
2. Date & Time
3. Math & Trig
4. Statistical
5. Lookup & Reference
6. Database
7. Text
8. Logical
9. Information
10. Commands (this category is normally hidden)
11. Customizing (this category is normally hidden)
12. Macro Control (this category is normally hidden)
13. DDE/External (this category is normally hidden)
14. User Defined (default)
15. Engineering (this category is valid only if the Analysis Toolpak add-in is installed)

How can I create a new function category?

You can't.

I have a custom function that will be used in a worksheet formula. If the user enters arguments that are not appropriate, how can I make the function return a true error value (#VALUE)?

If your function is named MyFunction, you can use the following statement to return an error value to the cell that contains the function:

MyFunction = CVErr(xlErrValue)

In this example, xlErrValue is a predefined constant. Constants for the other error values are listed in the online help.

Can I use Excel's built-in worksheet functions in my VBA code?

In most cases, yes. Excel's worksheet functions are accessed via the WorksheetFunction method of the Application object. For example, you could access the POWER worksheet functions with a statement such as the following:

Ans = Application.WorksheetFunction.Power(5, 3) 

This example raises 5 to the third power.

Generally, if VBA includes an equivalent function, you cannot use Excel's worksheet version. For example, because VBA has a function to compute square roots (Sqr) you cannot use the SQRT worksheet function in your VBA code.

Excel 95 doesn't support the WorksheetFunction method. Does that mean I can't make my Excel 2000 application compatible with Excel 95?

No. Actually, using the WorksheetFunction method is superfluous. The following statements have exactly the same result:

Ans = Application.WorksheetFunction.Power(5, 3) 
Ans = Application.Power(5, 3) 

Is there any way to force a line break in the text of a message box?

Use a carriage return or a line feed character to force a new line. The following statement displays the message box text on two lines. vbCr is a built-in constant that represents a carriage return.

MsgBox "Hello" & vbCr & Application.UserName

Extended Date Functions

Category: General / VBA Functions | [Item URL]

A companion file is available: Click here to download

Many users are surprised to discover that Excel cannot work with dates prior to the year 1900. I create an add-in that addresses this deficiency. The Extended Date Functions add-in (XDate) allows you to work with dates in the years 0100 through 9999.

When the XDate add-in is installed, you can use any of the following new worksheet functions in your formulas:

• XDATE(y,m,d,fmt): Returns a date for a given year, month, and day. As an option, you can provide a date formatting string.
• XDATEADD(xdate1,days,fmt): Adds a specified number of days to a date. As an option, you can provide a date formatting string.
• XDATEDIF(xdate1,xdate2): Returns the number of days between two dates.
• XDATEYEARDIF(xdate1,xdate2): Returns the number of full years between two dates (useful for calculating ages).
• XDATEYEAR(xdate1): Returns the year of a date.
• XDATEMONTH(xdate1): Returns the  month of a date.
• XDATEDAY(xdate1): returns the day of a date.
• XDATEDOW(xdate1): Returns the day of the week of a date (as an integer between 1 and 7).

These are all VBA functions.

Applications:

The XDate add-in is particularly useful for genealogists and others who need to perform simple calculations using pre-1900 dates. The figure below, for example, shows the XDATEYEARDIF function being used to calculate ages.

Requirements:

The XDate add-in requires Excel 97 or later.

Limitations:

Be careful if you use dates prior to 1752. Differences between the historical American, British, Gregorian, and Julian calendars can result in inaccurate computations.

Note:

My Power Utility Pak also includes the XDATE functions. However, they are not packaged in an add-in. Rather, you can add the functions directly to the VBA project for your workbook. As a result, you can distribute the workbook without a dependent add-in.

Documentation:

Complete context-sensitive online help is included.

Installation:

Installation is a two-step process:

1. Extract the files
   Download and execute the xdate.zip file. Extract the files into any directory.
2. Install the add-in
   Start Excel and select the Tools - Add-Ins command. In the Add-Ins dialog box, click the Browse button and locate xdate.xla (the file you extracted in Step #2). Click OK.

You can type the functions manually, or use Excel's Paste Function dialog box. To access the Paste Function dialog, click the Paste Function button, or select Insert - Function.  The XDate Functions are listed in the 'Date & Time' Category. When a function is selected in the Paste Function dialog, press F1 to read the online help.

Page 3 of 3 pages
[Previous page]