<

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x

My Favorite Code Snippets

Published on
7,375 Points
875 Views
5 Endorsements
Last Modified:
Approved
Martin Liss
Over 40 years of programming experience. Expand my "Full Biography" to see links to some articles I've written.
This article presents several of 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!

5
Comment
Author:Martin Liss
0 Comments

Featured Post

Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

Join & Write a Comment

This lesson discusses how to use a Mainform + Subforms in Microsoft Access to find and enter data for payments on orders. The sample data comes from a custom shop that builds and sells movable storage structures that are delivered to your property. …
Learn how to collaborate with office 365 Office Online

Keep in touch with Experts Exchange

Tech news and trends delivered to your inbox every month