User-Defined Function Argument Descriptions In Excel 2010
One of the new features in Excel 2010 is the ability to provide argument descriptions for user-defined functions. These descriptions appear in Function Arguments dialog box -- which is displayed after you choose a function using the Insert Function dialog box.
Here's a simple (but very useful) user-defined function:
Function EXTRACTELEMENT(Txt, n, Separator) As String EXTRACTELEMENT = Split(Application.Trim(Txt), Separator)(n - 1) End Function
Here's a VBA macro that provides a description for the EXTRACTELEMENT function, assigns it to a function category, and provides a description for each of its three arguments:
Sub DescribeFunction() Dim FuncName As String Dim FuncDesc As String Dim Category As String Dim ArgDesc(1 To 3) As String FuncName = "EXTRACTELEMENT" FuncDesc = "Returns the nth element of a string that uses a separator character" Category = 7 'Text category ArgDesc(1) = "String that contains the elements" ArgDesc(2) = "Element number to return" ArgDesc(3) = "Single-character element separator" Application.MacroOptions _ Macro:=FuncName, _ Description:=FuncDesc, _ Category:=Category, _ ArgumentDescriptions:=ArgDesc End Sub
You need to run this macro only one time. After doing so, the descriptive information is stored in the workbook (or add-in) that defines the function.
Here's how the function appears in the Function Arguments dialog box:
What about compatibility with earlier versions?
If the file is opened in Excel 2007, the argument descriptions are not
displayed. If you save the workbook as an XLS file, the Compatibility Checker
kicks in and tells you that the function descriptions will be removed.
Extracting An Email Address From Text
This tip describes a VBA function that accepts a text string as input, and returns the first email address found in the text. The figure below shows this function in use. The formula in cell B2 is:
If an email address is not found, the function returns an empty string. Also, note that it only extracts the first email address.
The function is not very elegant. It just starts with the first "at symbol" it finds, and examines the characters before and after the at symbol.
Function ExtractEmailAddress(s As String) As String Dim AtSignLocation As Long Dim i As Long Dim TempStr As String Const CharList As String = "[A-Za-z0-9._-]" 'Get location of the @ AtSignLocation = InStr(s, "@") If AtSignLocation = 0 Then ExtractEmailAddress = "" 'not found Else TempStr = "" 'Get 1st half of email address For i = AtSignLocation - 1 To 1 Step -1 If Mid(s, i, 1) Like CharList Then TempStr = Mid(s, i, 1) & TempStr Else Exit For End If Next i If TempStr = "" Then Exit Function 'get 2nd half TempStr = TempStr & "@" For i = AtSignLocation + 1 To Len(s) If Mid(s, i, 1) Like CharList Then TempStr = TempStr & Mid(s, i, 1) Else Exit For End If Next i End If 'Remove trailing period if it exists If Right(TempStr, 1) = "." Then TempStr = _ Left(TempStr, Len(TempStr) - 1) ExtractEmailAddress = TempStr End Function
Quantifying Color Choices
A companion file is available: Click here to download
I got lots of Excel workbooks via email. A significant number of them have some downright ugly color choices. Beauty is in the eye of the beholder, but there's no excuse for making color choices that result in illegible text.
The World Wide Web Consortium (W3C) has created some formulas that can help you determine if your foreground and background colors are legible: Ensure that foreground and background color combinations provide sufficient contrast when viewed by someone having color deficits or when viewed on a black and white screen.
The W3C presents two formulas, each of which returns a value:
- Color Brightness Difference: returns a value between 0 and 255
- Color Difference: Returns a value between 0 and 765
I converted their formulas into VBA functions, and formulas that use these functions are shown in Columns B and C:
To be an acceptable color combination, the Color Difference score should be 500 or greater, and the Brightness Difference score should be 125 or greater. I used conditional formatting to highlight values that exceed these minimums.
Column D has a simple formula that determines if both score meet the minimum requirement.
These formulas seem to work quite well. The color combination deemed Acceptable are all very legible. Bottom line: You can't go wrong with black text on a white background. Reserve the fancy colors for column headers, or for special areas of a worksheet that you want to be noticed.
Determining The User’s Video Resolution
How you can determine the current video resolution? There are two ways that I'm aware of:
- Maximize Excel's window and then access the Application's Width and Height properties
- Use a Windows API function
This document presents VBA code to demonstrate both of these techniques.
Getting Excel's window size
The VBA subroutine below maximizes Excel's window, and then displays the width and height.
Sub ShowAppSize() ' Maximize the window Application.WindowState = xlMaximized ' Get the dimensions appWidth = Application.Width appHeight = Application.Height ' Show a message box Msg = "Excel's window size is: " Msg = Msg & appWidth & " X " & appHeight MsgBox Msg End Sub
This subroutine is quite straightforward, and works with Excel 5 or later versions. The disadvantage is that Excel's metric system does not correspond to pixels. For example, when the video resolution is 1024 X 768 pixels, the preceding subroutine reports that the maximized window size is 774 X 582.
Using the GetSystemMetrics API function
The subroutine below demonstrates how to use a Windows API function to determine the current video resolution. The result is expressed in pixels.
' API declaration Declare Function GetSystemMetrics32 Lib "user32" _ Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long Public Const SM_CXSCREEN = 0 Public Const SM_CYSCREEN = 1 Sub DisplayVideoInfo() vidWidth = GetSystemMetrics32(SM_CXSCREEN) vidHeight = GetSystemMetrics32(SM_CYSCREEN) Msg = "The current video mode is: " Msg = Msg & vidWidth & " X " & vidHeight MsgBox Msg End Sub
Identifying Unique Values In An Array Or Range
Have you ever had to work with just the unique items in a range? If your data is in the form of a database, you can use the Advanced Filter command to extract the unique items from a single column. But if your data spans multiple columns, Advanced Filter won't work. And the Advanced Filter won't do you any good if your data is in a VBA array.
In this document I present a VBA function that accepts either a worksheet range object or a VBA array. The function returns either:
- A variant array that consists of just the unique elements in the input array or range (or)
- A single value: the number of unique elements in the input array or range.
Here's the syntax for the UniqueItems function (which is listed at the end of this document):
- ArrayIn: A range object, or an array
- Count: (Optional) If True or omitted, the function returns a single value - the number of unique items in ArrayIn. If False, the function returns an array that consists of the unique items in ArrayIn.
The subroutine below demonstrates UniqueItems. The routine generates 100 random integers and stores them in an array. This array is then passed to the UniqueItems function and a message box displays the number of unique integers in the array. The number will vary each time you run the subroutine.
Sub Test1() Dim z(1 To 100) For i = 1 To 100 z(i) = Int(Rnd() * 100) Next i MsgBox UniqueItems(z, True) End Sub
The subroutine below counts the number of common elements in two worksheet ranges. It creates two arrays. Array1 consists of the unique items in A1:A16; Array2 consists of the unique items in B1:B16. A nested loop counts the number of items that are in both ranges.
Sub Test2() Set Range1 = Sheets("Sheet1").Range("A1:A16") Set Range2 = Sheets("Sheet1").Range("B1:B16") Array1 = UniqueItems(Range1, False) Array2 = UniqueItems(Range2, False) CommonCount = 0 For i = LBound(Array1) To UBound(Array1) For j = LBound(Array2) To UBound(Array2) If Array1(i) = Array2(j) Then _ CommonCount = CommonCount + 1 Next j Next i MsgBox CommonCount End Sub
The UniqueItems function can also be used in worksheet formulas. The formula below returns the number of unique items in a range:
To display the unique items in a range, you must array-enter the formula into a range of cells (use Ctrl+Shift+Enter). The result of the UniqueItems function is a horizontal array. If you would like to display the unique values in a column, you can use the TRANSPOSE function. The formula below (which is array-entered into a vertical range) returns the unique items in A1:D21.
Option Base 1 Function UniqueItems(ArrayIn, Optional Count As Variant) As Variant ' Accepts an array or range as input ' If Count = True or is missing, the function returns the number of unique elements ' If Count = False, the function returns a variant array of unique elements Dim Unique() As Variant ' array that holds the unique items Dim Element As Variant Dim i As Integer Dim FoundMatch As Boolean ' If 2nd argument is missing, assign default value If IsMissing(Count) Then Count = True ' Counter for number of unique elements NumUnique = 0 ' Loop thru the input array For Each Element In ArrayIn FoundMatch = False ' Has item been added yet? For i = 1 To NumUnique If Element = Unique(i) Then FoundMatch = True Exit For '(exit loop) End If Next i AddItem: ' If not in list, add the item to unique list If Not FoundMatch And Not IsEmpty(Element) Then NumUnique = NumUnique + 1 ReDim Preserve Unique(NumUnique) Unique(NumUnique) = Element End If Next Element ' Assign a value to the function If Count Then UniqueItems = NumUnique Else UniqueItems = Unique End Function
(Thanks to Peter Atherton for suggesting the method to avoid converting blanks to zero values)
Getting A List Of File Names Using VBA
If your macro needs to present a list of files for the user to choose from, the easiest approach is to use the GetOpenFileName method of the Application object. For example, the code below displays the standard File Open dialog box. If the user selects a file, the filename is stored in SelectedFile; if the user clicks Cancel, SelectedFile is equal to False.
Filter = "Excel files (*.xls), *.xls" Caption = "Select a File" SelectedFile = Application.GetOpenFilename(Filter, , Caption)
In some cases, however, you may want to get a list of all files in a particular directory. The VBA function below (GetFileList) accepts a DOS path and filespec as its argument, and returns a variant array that contains all of the filenames in that directory. If no matching files are found, the function returns False.
Function GetFileList(FileSpec As String) As Variant ' Returns an array of filenames that match FileSpec ' If no matching files are found, it returns False Dim FileArray() As Variant Dim FileCount As Integer Dim FileName As String On Error GoTo NoFilesFound FileCount = 0 FileName = Dir(FileSpec) If FileName = "" Then GoTo NoFilesFound ' Loop until no more matching files are found Do While FileName <> "" FileCount = FileCount + 1 ReDim Preserve FileArray(1 To FileCount) FileArray(FileCount) = FileName FileName = Dir() Loop GetFileList = FileArray Exit Function ' Error handler NoFilesFound: GetFileList = False End Function
The subroutine listed below demonstrates how to use this function. In this example, the filespec is passed to the GetFileList function and the result is stored in x. If x is an array, it means that matching files were found. A message box displays the number of files and the filenames are copied to column A in Sheet1. If x is not an array, it means that no matching files were found.
Sub test() Dim p As String, x As Variant p = "c:/msoffice/excel/library/*.xls" x = GetFileList(p) Select Case IsArray(x) Case True 'files found MsgBox UBound(x) Sheets("Sheet1").Range("A:A").Clear For i = LBound(x) To UBound(x) Sheets("Sheet1").Cells(i, 1).Value = x(i) Next i Case False 'no files found MsgBox "No matching files" End Select End Sub
Looping Through Ranges Efficiently In Custom Worksheet Functions
If you create custom worksheet functions using VBA, this tip describes how to write efficient looping code.
Consider the following custom worksheet function.
Function CountBetween(InRange, Lower, Upper) TheCount = 0 For Each Cell In InRange If Cell.Value >= Lower And Cell.Value <= Upper _ Then TheCount = TheCount + 1 Next Cell CountBetween = TheCount End Function
This function returns the number of cells in a range that fall between two values. The first argument is a range, the second argument is the lower comparison value, and the third argument is the upper comparison value. If you wanted to count the number of values between 1 and 5 in the range A1:A20, you could use this formula:
This function works fine in most situations. However, try entering the following formula and see what happens:
You'll find that evaluating this function seems to take forever since it will loop through all cells in the range -- even those that are beyond the worksheet's "used range."
My original approach to solving this problem was to use the SpecialCells method to create a subset of the input range that consisted only of nonempty cells. However, I discovered that SpecialCells is off-limits inside of a worksheet function.
I eventually learned the solution. The function below uses the Intersect function to create a new range object that consists of the intersection of the UsedRange and the input range.
Function CountBetween2(InRange, Lower, Upper) Set SubSetRange = Intersect(InRange.Parent.UsedRange, InRange) TheCount = 0 For Each Cell In SubSetRange If Cell.Value >= Lower And Cell.Value <= Upper Then _ TheCount = TheCount + 1 Next Cell CountBetween2 = TheCount End Function
The addition of the Set statement solves the problem. You'll find that this function works equally fast with either of these formulas:
This technique can be adapted to any custom worksheet function that accepts a range argument and loops through each cell in the range.
Undoing A VBA Subroutine
Computer users are accustomed to the ability to "undo" an operation. Almost every operation you perform in Excel can be undone. If you program in VBA, you may have wondered if it's possible to undo the effects of a subroutine. The answer is yes. The qualified answer is it's not always easy.
Making the effects of your subroutines undoable isn't automatic. Your subroutine will need to store the previous state so it can be restored if the user choose the Edit Undo command. How you do this will vary, depending on what the subroutine does. In extreme cases, you might need to save an entire worksheet. If your subroutine modifies a range, for example, you need only save the contents of that range.
The code below demonstrates how to enable the Edit Undo command after a subroutine is executed. The subroutine itself is very simple: it simply inserts a 0 into every cell in the current range selection. The bulk of the code is used to save the contents of the current selection.
Trying it out
To try out this example code:
- Copy the code to an empty VBA module.
- Enter some data into a worksheet range.
- Select the range and execute the ZeroRange subroutine. The cells will be replaced with zeros.
- Select the Edit Undo command. The original contents of the selection will be restored.
How it works
The OldSelection array stores the cell address and the cell contents (using a custom data type). Notice that this array is declared as a Public variable so it's available to all subroutines. The last statement in the ZeroRange subroutine specifies the text to display in the Undo menu, and the subroutine to call if this command is selected. The UndoZero routine loops through the OldSelection array and restores the values to their appropriate cells. Notice that I also store the workbook and worksheet -- which ensures that the correct cells will be restored even if the user switches out of the original worksheet.
The Undo example
'Custom data type for undoing Type SaveRange Val As Variant Addr As String End Type ' Stores info about current selection Public OldWorkbook As Workbook Public OldSheet As Worksheet Public OldSelection() As SaveRange Sub ZeroRange() ' Inserts zero into all selected cells ' Abort if a range isn't selected If TypeName(Selection) <> "Range" Then Exit Sub ' The next block of statements ' Save the current values for undoing ReDim OldSelection(Selection.Count) Set OldWorkbook = ActiveWorkbook Set OldSheet = ActiveSheet i = 0 For Each cell In Selection i = i + 1 OldSelection(i).Addr = cell.Address OldSelection(i).Val = cell.Formula Next cell ' Insert 0 into current selection Application.ScreenUpdating = False Selection.Value = 0 ' Specify the Undo Sub Application.OnUndo "Undo the ZeroRange macro", "UndoZero" End Sub Sub UndoZero() ' Undoes the effect of the ZeroRange sub ' Tell user if a problem occurs On Error GoTo Problem Application.ScreenUpdating = False ' Make sure the correct workbook and sheet are active OldWorkbook.Activate OldSheet.Activate ' Restore the saved information For i = 1 To UBound(OldSelection) Range(OldSelection(i).Addr).Formula = OldSelection(i).Val Next i Exit Sub ' Error handler Problem: MsgBox "Can't undo" End Sub
Other examples of Undo
If you've purchased the source code to Power Utility Pak, you can examine these utilities for other, more complex, examples of using undo.
Determining The Last Non-empty Cell In A Column Or Row
This tip presents two useful VBA functions that can be used in worksheet formulas. LASTINCOLUMN returns the contents of the last non-empty cell in a column; LASTINROW returns the contents of the last non-empty cell in a row. Each function accepts a range as its single argument. The range argument can be a complete column (for LASTINCOLUMN) or a complete row (for LASTINROW). If the supplied argument is not a complete column or row, the function uses the column or row of the upper left cell in the range. For example, the following formula returns the last value in column B:
The formula below returns the last value in row 7:
You'll find that these functions are quite fast, since they only examine the cells in the intersection of the specified column (or row) and the worksheet's used range.
The LASTINCOLUMN function
Function LASTINCOLUMN(rngInput As Range) Dim WorkRange As Range Dim i As Long, CellCount As Long Application.Volatile Set WorkRange = rngInput.Columns(1).EntireColumn Set WorkRange = Intersect(WorkRange.Parent.UsedRange, WorkRange) CellCount = WorkRange.Count For i = CellCount To 1 Step -1 If Not IsEmpty(WorkRange(i)) Then LASTINCOLUMN = WorkRange(i).Value Exit Function End If Next i End Function
The LASTINROW function
Function LASTINROW(rngInput As Range) As Variant Dim WorkRange As Range Dim i As Long, CellCount As Long Application.Volatile Set WorkRange = rngInput.Rows(1).EntireRow Set WorkRange = Intersect(WorkRange.Parent.UsedRange, WorkRange) CellCount = WorkRange.Count For i = CellCount To 1 Step -1 If Not IsEmpty(WorkRange(i)) Then LASTINROW = WorkRange(i).Value Exit Function End If Next i End Function
This tip describes a technique that may be helpful in some situations - making a single worksheet function act like multiple functions. For example, the VBA listing below is for a custom function called StatFunction. It takes two arguments: the range (rng), and the operation (op). Depending on the value of op, the function will return any of the following: AVERAGE, COUNT, MAX, MEDIAN, MIN, MODE, STDEV, SUM, or VAR.
For example, you can use this function in your worksheet as follows:
The result of the formula depends on the contents of cell A24 -- which should be a string such as Average, Count, Max, etc. You can adapt this technique for other types of functions.
The StatFunction Function
Function STATFUNCTION(rng, op) Select Case UCase(op) Case "SUM" STATFUNCTION = Application.Sum(rng) Case "AVERAGE" STATFUNCTION = Application.Average(rng) Case "MEDIAN" STATFUNCTION = Application.Median(rng) Case "MODE" STATFUNCTION = Application.Mode(rng) Case "COUNT" STATFUNCTION = Application.Count(rng) Case "MAX" STATFUNCTION = Application.Max(rng) Case "MIN" STATFUNCTION = Application.Min(rng) Case "VAR" STATFUNCTION = Application.Var(rng) Case "STDEV" STATFUNCTION = Application.StDev(rng) Case Else STATFUNCTION = Evaluate("NA()") End Select End Function
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