My Favorite Code Snippets

I’ve been programming in VBA for a long time and also helping out here for a long time, and over the course of those years when I’ve developed or come across code that is clever and/or useful and/or uses “out of the box” type thinking I save the code snippet in a notebook application where I can readily find and use them when needed, and this article describes a few of my favorites in no particular order.

Two-Color conditional formatting based on another column

I was helping someone with their project and one thing that they wanted to do was to highlight the cells in one of the columns based on the values in another.  Her data looked like this.

She wanted the ‘Numbers’ column to be highlighted based on the values in the ‘Count’ column. Looking at the request I said “conditional formatting, no problem”, but when I went to do it I found that it’s not possible to do conditional formatting of one column based on another. 

I thought about it a while and realized that the data was the result of a macro and did not have to respond to manual changes, so I could do something a little out of the box. What I came up with was this code which copies the ‘Count’ data to a temporary column, conditionally formats that column and then copies the resulting colors to the ‘Numbers’ column and voilà! Here’s the code I used.

Sub TwoColorCF()
Dim lngRow As Long


Application.ScreenUpdating = False
' Copy the Count data to a temporary column
Range("B2:B16").Copy Destination:=Range("D2:D16")


' Apply 2-color, Yellow to Green, conditional formatting to the copied data.
' The code for this was taken from a macro recording.
Range("D2:D16").Select
Selection.FormatConditions.AddColorScale ColorScaleType:=2
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _
    xlConditionValueLowestValue
With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
    .Color = 65535
    .TintAndShade = 0
End With
Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _
    xlConditionValueHighestValue
With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
    .ThemeColor = xlThemeColorAccent6
    .TintAndShade = 0
End With


' Transfer the conditional formatting colors to the Numbers column
For lngRow = 2 To 16
    Cells(lngRow, "A").Interior.Color = Cells(lngRow, "D").DisplayFormat.Interior.Color
Next
' Delete the temporary column
Columns("D").Delete


Application.ScreenUpdating = True
End Sub

The result was this.

Working with Absolute Addresses

When dealing with addresses in one of the Worksheet methods like SelectionChange, you need to be aware that the addresses contained in the Target are absolute addresses and look something like '$C$7'. Before I knew better and I needed to refer to a specific cell like C7, I would do something like this.

If Replace(Target.Address, "$", "") = "C7" Then

That works, and while everyone but me may have known about it, I "discovered" this built-in feature of Excel, and since it's faster to use what's built into Excel then your own code, I now do this.

If Target.Address(0, 0) = "C7" Then…

The zeros are RowAbsolute and ColumnAbsolute and when 0 (or False) the dollar signs are ignored and when 1 (or True), they’re not.

Centering Text Across Cells Without Merging Them

Merged cells can cause difficulties in VBA and in cases where you want to center text across two or more cells, you can do this rather than merging the cells. 

1. Enter text in a cell like A1. (It must be the left-most cell of the desired range)
2. Select a range like A1:B1
3. Format Cells|Alignment|Horizontal|Center Across Selection
4. Click OK

In this case Range("A1") will return the text value while Range("B1") will return a blank.

Using Checkmarks without Having to Use Controls

Checkmarks on a sheet can be useful to indicate for example that you want to do something with an adjacent cell, or that some process is complete. Here’s an easy way to create a checkmark toggle without needing to use a Control. Set the font for the cell(s) to Wingdings 2, make its value an uppercase “P” and add this code.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Rows.Count > 1 Then
    Exit Sub
End If
If Not Intersect(ActiveCell, Range("B2:B21")) Is Nothing Then
    Select Case Target
        Case ""
            Target = "P"
        Case Else
            Target = ""
     End Select
End If
End Sub

Clear a Worksheet below its Headings

Here's a simple way to clear a worksheet while retaining the sheet's headings. I use this all the time.

' The '1' is the number of heading rows
Activesheet.UsedRange.Cells.Offset(1, 0).ClearContents

You can use 'Clear' instead of 'ClearContents' if you also want to remove formatting.

Convert a Column Letter to a Number and Vice Versa

Function ColLetterToNum(ByVal sColLetter As String) As Long
' Convert a column letter to a number
     ColLetterToNum = ActiveWorkbook.Worksheets(1).Columns(sColLetter).Column
End Function

Function ColNumToLetter(lColNum As Long) As String
' Convert a column number to a letter
    ColNumToLetter = Split(Cells(1, lColNum).Address, "$")(1)
End Function

Detect No entry or Esc in an InputBox

In other words when those pesky users do the unexpected.

Dim strDesired As String

strDesired = InputBox("How many do you want?")
If StrPtr(strDesired) = 0 Then
    ' User pressed Escape, clicked 'Cancel' or didn't enter anything
    MsgBox "You didn't enter anything; quitting"
    Exit Sub
End If

Create Unique Keys for Items in a Collection

Collections are useful ('Dictionaries' are better) for creating, well, collections of data and if you want to include keys with the items in the collection then those keys need to be unique. Here's a simple function for doing that and an example of how to use it.

Public Function UniqueKey() As String
'***************************************************************************
'Purpose: Generate a unique key. Actually there is a one in
'         10 million chance of the key *not* being unique, but the error
'         handling code in the calling Sub takes care of that.
'Inputs : None
'Outputs: The key for the Treeview
'***************************************************************************

    UniqueKey = "K" & 1 + Int(Rnd() * 10000000)

End Function

Sub TestUniqueKeyGeneration()

Randomize

On Error GoTo ErrorRoutine
' Do something with the key. This example will of course
' never cause an error and is just here for illustration.
MsgBox UniqueKey

ErrorRoutine:

    If Err.Number = 35602 Then
        ' Duplicate key, get a different one
        Resume
    End If

End Sub

I hope you found that one or more of the above was helpful

If so then please click the “Thumb’s Up” button below. Doing so lets me know what is valuable for EE members and provides direction for future articles. It also provides me with positive feedback in the form of a few points. Thanks!