Some Useful VBA Functions
This tip contains VBA code for six simple, but very useful functions. You can simply copy the code and paste it to your module.
- FileExists - Returns TRUE if a particular file exists.
- FileNameOnly- Extracts the filename part of a path/filename string.
- PathExists - Returns TRUE if a particular path exists.
- RangeNameExists - Returns TRUE if a particular range name exists.
- SheetExists - Returns TRUE if a particular sheet exists.
- WorkBookIsOpen - Returns TRUE if a particular workbook is open.
The FileExists Function
Private Function FileExists(fname) As Boolean ' Returns TRUE if the file exists Dim x As String x = Dir(fname) If x <> "" Then FileExists = True _ Else FileExists = False End Function
The FileNameOnly Function
Private Function FileNameOnly(pname) As String ' Returns the filename from a path/filename string Dim i As Integer, length As Integer, temp As String length = Len(pname) temp = "" For i = length To 1 Step -1 If Mid(pname, i, 1) = Application.PathSeparator Then FileNameOnly = temp Exit Function End If temp = Mid(pname, i, 1) & temp Next i FileNameOnly = pname End Function
The PathExists Function
Private Function PathExists(pname) As Boolean ' Returns TRUE if the path exists Dim x As String On Error Resume Next x = GetAttr(pname) And 0 If Err = 0 Then PathExists = True _ Else PathExists = False End Function
The RangeNameExists Function
Private Function RangeNameExists(nname) As Boolean ' Returns TRUE if the range name exists Dim n As Name RangeNameExists = False For Each n In ActiveWorkbook.Names If UCase(n.Name) = UCase(nname) Then RangeNameExists = True Exit Function End If Next n End Function
The SheetExists Function
Private Function SheetExists(sname) As Boolean ' Returns TRUE if sheet exists in the active workbook Dim x As Object On Error Resume Next Set x = ActiveWorkbook.Sheets(sname) If Err = 0 Then SheetExists = True _ Else SheetExists = False End Function
The WorkbookIsOpen Function
Private Function WorkbookIsOpen(wbname) As Boolean ' Returns TRUE if the workbook is open Dim x As Workbook On Error Resume Next Set x = Workbooks(wbname) If Err = 0 Then WorkbookIsOpen = True _ Else WorkbookIsOpen = False End Function
Using The GetSetting & SaveSetting Functions
The Windows registry is a central storehouse that is used by applications to store information such as user preferences. Prior to Excel 97, accessing the registry required API calls. Excel 97 (and later versions) includes two handy VBA functions:
- GetSetting: Retrieves a setting from the registry
- SaveSetting: Saves a setting to the registry
These two functions are described in the online help, so I won't cover the details here. However, it's important to understand that these functions work only with the following key name:
HKEY_CURRENT_USER\Software\VB and VBA Program Settings
In other words, you can't use these functions to access any key in the registry. Rather, these functions are most useful for storing information about your Excel application that you need to maintain between sessions.
The subroutine below, which is stored in the code module for the ThisWorkbook object, demonstrates the GetSetting and SaveSetting functions. This subroutine is executed when the workbook is opened. It retrieves two bits of information: the number of times the workbook has been opened; and the date and time the file was last opened. This information is displayed in a message box.
Private Sub Workbook_Open() Dim Counter As Long, LastOpen As String, Msg As String ' Get setting from registry Counter = GetSetting("XYZ Corp", "Budget", "Count", 0) LastOpen = GetSetting("XYZ Corp", "Budget", "Opened", "") ' Display the information Msg = "This file has been opened " & Counter & " times." Msg = Msg & vbCrLf & "Last opened: " & LastOpen MsgBox Msg, vbInformation, ThisWorkbook.Name ' Update the information and store it Counter = Counter + 1 LastOpen = Date & " " & Time SaveSetting "XYZ Corp", "Budget", "Count", Counter SaveSetting "XYZ Corp", "Budget", "Opened", LastOpen End Sub
The image below shows how these settings appear in the registry (using the Windows regedit.exe program).
Determining The Data Type Of A Cell
In some situations you may need to determine the type of data in a cell. Excel provides a number of built-in functions that can help. These include ISTEXT, ISLOGICAL, and ISERROR. In addition, VBA includes functions such as IsEmpty, IsDate, and IsNumeric.
The CellType function (VBA code is listed below) accepts a range argument and returns a string that describes the data type of the upper left cell in the range. The function returns one of the following strings: Blank, Text, Logical, Error, Date, Time, or Value.
The CellType function
Function CellType(c) ' Returns the cell type of the upper left ' cell in a range Application.Volatile Set c = c.Range("A1") Select Case True Case IsEmpty(c): CellType = "Blank" Case Application.IsText(c): CellType = "Text" Case Application.IsLogical(c): CellType = "Logical" Case Application.IsErr(c): CellType = "Error" Case IsDate(c): CellType = "Date" Case InStr(1, c.Text, ":") <> 0: CellType = "Time" Case IsNumeric(c): CellType = "Value" End Select End Function
Using the CellType function
To use this function in a worskheet, just copy the code and paste it to a module. Then, you can enter a formula such as:
A Custom Function For Relative Sheet References
You may have discovered that Excel's support for "3D workbooks" is limited. For example, if you need to refer to a different worksheet in a workbook, you must include the worksheet's name in your formula. This is not a big problem -- until you attempt to copy the formula across other worksheets. The copied formulas continue to refer to the original worksheet name.
This tip contains a VBA function (named SHEETOFFSET) that lets you address worksheets in a relative manner. For example, you can refer to cell A1 on the previous worksheet using this formula:
Then, you can copy this formula to other sheets and the relative referencing will be in effect in all of the copied formulas.
The SHEETOFFSET Function
The VBA code for the SHEETOFFSET function is listed below.
Function SHEETOFFSET(offset, Ref) ' Returns cell contents at Ref, in sheet offset Application.Volatile With Application.Caller.Parent SHEETOFFSET = .Parent.Sheets(.Index + offset) _ .Range(Ref.Address).Value End With End Function
Using the SHEETOFFSET function
To use this function in a worksheet, just copy the code and paste it to a VBA module. Then, you can use formulas such as:
- The first argument represents the sheet offset, and it can be positive, negative, or 0.
- The second argument must be a reference to a single cell. If the first argument is 0, the cell reference must not be the same as the cell that contains the formula. If so, you'll generate a circular reference error.
NOTE: Be careful if your workbook contains non-worksheet sheets (for example, chart sheets). If the offset argument results in a reference to a chart sheet, the function will display an error.
Determining If A Range Is Contained In A Range
In some situations, you may need to determine if a particular range is contained within another range. For example, you may need to determine if the active cell is in a particular range.
The InRange function, listed below, accepts two arguments (both Range objects). The function returns True if the first range is contained in the second range. Notice that the function checks to make sure that the two range arguments are contained in the same sheet and in the same workbook.
You can use the InRange function in your VBA code, or in a worksheet function.
The InRange Function
The VBA code for the InRange function is listed below.
Function InRange(rng1, rng2) As Boolean ' Returns True if rng1 is a subset of rng2 InRange = False If rng1.Parent.Parent.Name = rng2.Parent.Parent.Name Then If rng1.Parent.Name = rng2.Parent.Name Then If Union(rng1, rng2).Address = rng2.Address Then InRange = True End If End If End If End Function
Listed below is a simple example that uses the InRange function. The subroutine prompts the user to select a range, and then checks the range using the InRange function. If the user's selection is not within A1:E20, the prompt appears again.
Sub Test() Dim ValidRange As Range, UserRange As Range Dim SelectionOK As Boolean Set ValidRange = Range("A1:E20") SelectionOK = False On Error Resume Next Do Until SelectionOK = True Set UserRange = Application.InputBox(Prompt:="Select a range", Type:=8) If TypeName(UserRange) = "Empty" Then Exit Sub If InRange(UserRange, ValidRange) Then MsgBox "The range is valid." SelectionOK = True Else MsgBox "Select a range within " & ValidRange.Address End If Loop End Sub
Determining If A Worksheet Or Workbook Has Code
Every workbook and sheet has a corresponding code module. These code modules can contain VBA code to handle workbook or sheet-level events. For example, a workbook code module (named ThisWorkbook by default) might have a subroutine declared as follows:
Private Sub Workbook_Open() ' Code goes here End Sub
The Workbook_Open sub is executed whenever the workbook is opened.
Similarly, code modules for worksheets can contain subroutines to handle worksheet event such as Activate, Deactivate, Change, etc.
Listed below are two custom VBA functions that you can use to determine if the code module for a particular workbook or worksheet contains any code.
The WorkbookHasVBACode Function
The function below takes a single argument: a workbook object. It returns True if the workbook's code module contains any VBA code.
Private Function WorkbookHasVBACode(wb As Workbook) ModuleLineCount = wb.VBProject.VBComponents(wb.CodeName). _ CodeModule.CountOfLines If ModuleLineCount = 0 Then WorkbookHasVBACode = False Else WorkbookHasVBACode = True End If End Function
The SheetHasVBACode Function
The function below takes a single argument: a worksheet object. It returns True if the worksheet's code module contains any VBA code.
Private Function SheetHasVBACode(wks As Worksheet) ModuleLineCount = wks.Parent.VBProject. _ VBComponents(wks.CodeName).CodeModule.CountOfLines If ModuleLineCount = 0 Then SheetHasVBACode = False Else SheetHasVBACode = True End If End Function
The example below demonstrates a practical use of the SheetHasVBACode function. The DeleteBlankSheets subroutine deletes all blank sheets in the active workbook -- but only if the sheet does not contain any VBA code.
Sub DeleteBlankSheets() Dim sht As Worksheet On Error GoTo ErrHandler ' Avoid Excel's confirmation prompt Application.DisplayAlerts = False ' Loop through each sheet For Each sht In ActiveWorkbook.Worksheets ' Is non-blank cell count zero? If Application.CountA(sht.Cells) = 0 Then ' Don't try to delete the last sheet If ActiveWorkbook.Sheets.Count <> 1 Then ' Don't delete sheet if it has VBA code If Not SheetHasVBACode(sht) Then sht.Delete End If End If End If Next sht Exit Sub ErrHandler: MsgBox sht.Name & Chr(13) & Chr(13) & Error(Err) End Sub
Searching Using Soundex Codes
A companion file is available: Click here to download
Soundex is an indexing system that translates a name into a 4-digit code consisting of one letter and three numbers. The advantage of Soundex is its ability to locate names by the way they sound, rather than by exact spelling. For example, consider the name Maris. This name has a Soundex code of M620. Other variations on this name (such as Mares, Marriss, Mariss, and Mairis) all have the same Soundex code.
- Each Soundex code has exactly four alphanumeric characters (1 letter and 3 numbers)
- The first letter of the name is always the first character of the Soundex code.
- The remaining three digits are defined from the name using the Soundex Key Codes listed below.
- Adjacent letters in the name which have the same Soundex Key code number are assigned a single digit.
- If the name is not long enough to yield four characters,the code is padded with zeros.
|1||B F P V|
|2||C G J K Q S X Z|
|No code||A E H I O U Y W|
The SOUNDEX function
This document presents a VBA function (named SOUNDEX) that converts a text string into a Soundex code. This function was developed by Richard J. Yanco.
The function can be used in a worksheet formula, or called from a VBA procedure. The SOUNDEX function is listed below. Notice that this function calls another function named Category.
Function SOUNDEX(Surname As String) As String ' Developed by Richard J. Yanco ' This function follows the Soundex rules given at ' http://home.utah-inter.net/kinsearch/Soundex.html Dim Result As String, c As String * 1 Dim Location As Integer Surname = UCase(Surname) ' First character must be a letter If Asc(Left(Surname, 1)) < 65 Or Asc(Left(Surname, 1)) > 90 Then SOUNDEX = "" Exit Function Else ' St. is converted to Saint If Left(Surname, 3) = "ST." Then Surname = "SAINT" & Mid(Surname, 4) End If ' Convert to Soundex: letters to their appropriate digit, ' A,E,I,O,U,Y ("slash letters") to slashes ' H,W, and everything else to zero-length string Result = Left(Surname, 1) For Location = 2 To Len(Surname) Result = Result & Category(Mid(Surname, Location, 1)) Next Location ' Remove double letters Location = 2 Do While Location < Len(Result) If Mid(Result, Location, 1) = Mid(Result, Location + 1, 1) Then Result = Left(Result, Location) & Mid(Result, Location + 2) Else Location = Location + 1 End If Loop ' If category of 1st letter equals 2nd character, remove 2nd character If Category(Left(Result, 1)) = Mid(Result, 2, 1) Then Result = Left(Result, 1) & Mid(Result, 3) End If ' Remove slashes For Location = 2 To Len(Result) If Mid(Result, Location, 1) = "/" Then Result = Left(Result, Location - 1) & Mid(Result, Location + 1) End If Next ' Trim or pad with zeroes as necessary Select Case Len(Result) Case 4 SOUNDEX = Result Case Is < 4 SOUNDEX = Result & String(4 - Len(Result), "0") Case Is > 4 SOUNDEX = Left(Result, 4) End Select End If End Function Private Function Category(c) As String ' Returns a Soundex code for a letter Select Case True Case c Like "[AEIOUY]" Category = "/" Case c Like "[BPFV]" Category = "1" Case c Like "[CSKGJQXZ]" Category = "2" Case c Like "[DT]" Category = "3" Case c = "L" Category = "4" Case c Like "[MN]" Category = "5" Case c = "R" Category = "6" Case Else 'This includes H and W, spaces, punctuation, etc. Category = "" End Select End Function
The demo file (linked above) contains a list of more than 4,000 names. You can search for a name in the list, and specify an exact match or an approximate match.
If you choose an approximate match, you'll get a list of names that have the same Soundex code as the name you're searching for.
Getting A List Of Installed Fonts
Your VBA procedure might need to present the user with a list of fonts to choose from. Or, you may need to determine if a particular font is installed. The simplest way to access the installed font list is to get the fonts from the Font control on the Formatting toolbar. The Font control contains a dropdown list of installed fonts, and you can write VBA code to retrieve that list from the control.
Displaying font names
The procedure listed below displays a list of installed fonts in Column A of the active worksheet. It uses the FindControl method to locate the Font control on the Formatting toolbar. If this control is not found (i.e., it was removed by the user) a temporary CommandBar is created and the Font control is added to it.
Sub ShowInstalledFonts() Set FontList = Application.CommandBars("Formatting").FindControl(ID:=1728) ' If Font control is missing, create a temp CommandBar If FontList Is Nothing Then Set TempBar = Application.CommandBars.Add Set FontList = TempBar.Controls.Add(ID:=1728) End If ' Put the fonts into column A Range("A:A").ClearContents For i = 0 To FontList.ListCount - 1 Cells(i + 1, 1) = FontList.List(i + 1) Next i ' Delete temp CommandBar if it exists On Error Resume Next TempBar.Delete End Sub
Is a font installed?
The function below uses the same technique as the ShowInstalledFonts procedure. it returns True if a specified font is installed.
Function FontIsInstalled(sFont) As Boolean ' Returns True if sFont is installed FontIsInstalled = False Set FontList = Application.CommandBars("Formatting").FindControl(ID:=1728) ' If Font control is missing, create a temp CommandBar If FontList Is Nothing Then Set TempBar = Application.CommandBars.Add Set FontList = TempBar.Controls.Add(ID:=1728) End If For i = 0 To FontList.ListCount - 1 If FontList.List(i + 1) = sFont Then FontIsInstalled = True On Error Resume Next TempBar.Delete Exit Function End If Next i ' Delete temp CommandBar if it exists On Error Resume Next TempBar.Delete End Function
The statement below demonstrates how to use this function in a VBA procedure. It displays True in a message box if the user's system contains the Comic Sans MS font.
MsgBox FontIsInstalled("Comic Sans MS")
A VBA Function To Get A Value From A Closed File
VBA does not include a method to retrieve a value from a closed file. You can, however, take advantage of Excel's ability to work with linked files.
This tip contains a VBA function that retrieves a value from a closed workbook. It does by calling an XLM macro.
Note: You cannot use this function in a worksheet formula.
The GetValue Function
The GetValue function, listed below takes four arguments:
- path: The drive and path to the closed file (e.g., "d:\files")
- file: The workbook name (e.g., "budget.xls")
- sheet: The worksheet name (e.g., "Sheet1")
- ref: The cell reference (e.g., "C4")
Private Function GetValue(path, file, sheet, ref) ' Retrieves a value from a closed workbook Dim arg As String ' Make sure the file exists If Right(path, 1) <> "\" Then path = path & "\" If Dir(path & file) = "" Then GetValue = "File Not Found" Exit Function End If ' Create the argument arg = "'" & path & "[" & file & "]" & sheet & "'!" & _ Range(ref).Range("A1").Address(, , xlR1C1) ' Execute an XLM macro GetValue = ExecuteExcel4Macro(arg) End Function
Using the GetValue Function
To use this function, copy the listing to a VBA module. Then, call the function with the appropriate arguments. The Sub procedure below demonstrates. It simply displays the value in cell A1 in Sheet1 of a file named Budget.xls, located in the XLFiles\Budget directory on drive C:.
Sub TestGetValue() p = "c:\XLFiles\Budget" f = "Budget.xls" s = "Sheet1" a = "A1" MsgBox GetValue(p, f, s, a) End Sub
Another example is shown below. This procedure reads 1,200 values (100 rows and 12 columns) from a closed file, and places the values into the active worksheet.
Sub TestGetValue2() p = "c:\XLFiles\Budget" f = "Budget.xls" s = "Sheet1" Application.ScreenUpdating = False For r = 1 To 100 For c = 1 To 12 a = Cells(r, c).Address Cells(r, c) = GetValue(p, f, s, a) Next c Next r Application.ScreenUpdating = True End Sub
In order for this function to work properly, a worksheet must be active in Excel. It will generate an error if all windows are hidden, or if the active sheet is a Chart sheet.
Playing A Sound Based On A Cell’s Value
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:
The sound will play when the value in cell A1 is greater than or equal to 1,000.
The sound will play when the value in cell C12 is negative.
- 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.
Search for Tips
Browse Tips by Category
Needs tips? Here are two books, with nothing but tips:
Contains more than 200 useful tips and tricks for Excel 2007 | Other Excel 2007 books | Amazon link: John Walkenbach's Favorite Excel 2007 Tips & Tricks