Excel VBA: Faster way of finding the column letter of a header? - vba

Question

I have this code for finding the column letter of a given header:
Public Function GetColumnLetter(ByRef in_cells As Range, ByVal column_header As String, Optional look_at As Excel.XlLookAt = xlPart) As String
GetColumnLetter = Split(in_cells.Find(what:=column_header, LookAt:=look_at, SearchOrder:=xlByRows).Address(ColumnAbsolute:=False), "$")(0)
End Function
But it seems to be a little slow. It seems to take a few seconds on some worksheets when it seems like it shouldn't take more than a second. I have to do this for a number of different columns in a number of different worksheets.
Is there a faster way of doing this?
EDIT: I just made a helper function that calls this function, but w/just the first row (in_cells.Range("1:1)), and also changed xlByRows to xlByColumns, and this has sped things enough.

Answer 1

For what it's worth, here is an extremely fast function that does what you want without invoking Find. According to my (very old) notes, it came from here. The parameter c represents the index of the column in question, as in the property Selection.Column.
Public Function GetColumnLetter(ByVal c As Long) As String
Dim p As Long
While c
p = 1 + (c - 1) Mod 26
c = (c - p) \ 26
GetColumnLetter = Chr$(64 + p) & GetColumnLetter
Wend
End Function
EDIT: Given clarifications in comments, here is a setup for testing .Find vs .Match, which appears to be faster. Using the variant values of the array might be faster still, but I'll leave it here.
Set up a first row of data:
Public Sub MakeUglyFirstRow()
Dim rng As Excel.Range
Dim i As Long, p As Long
Dim strChar As String
Dim initialLength As Integer
Set rng = ActiveSheet.Rows(1)
initialLength = 5
For i = 1 To rng.Cells.Count
p = 1 + (i - 1) Mod 26
strChar = String(initialLength, Chr$(64 + p))
rng.Cells(i).Value = strChar
If i Mod 26 = 0 Then initialLength = initialLength + 1
Next i
End Sub
The original function (plus error handling for a value not found), and a match version calling the function above:
Public Function GetColumnLetter_ByFind(ByRef in_cells As Range, ByVal column_header As String, Optional look_at As Excel.XlLookAt = xlPart) As String
Dim rngFound As Excel.Range
Set rngFound = in_cells.Find(what:=column_header, LookAt:=look_at, SearchOrder:=xlByRows)
If Not (rngFound Is Nothing) Then
GetColumnLetter_ByFind = Split(rngFound.Address(ColumnAbsolute:=False), "$")(0)
End If
End Function
Public Function GetColumnLetter_ByMatch(in_cells As Range, text_to_find As String, Optional look_at As Excel.XlLookAt = XlLookAt.xlPart) As String
On Error Resume Next
Dim rngFirstRow As Excel.Range
Dim result As Variant
Dim col As Long
Dim r As Long
Set rngFirstRow = in_cells.Rows(1)
col = 0
With Application.WorksheetFunction
If look_at = xlPart Then
result = .Match("*" + text_to_find + "*", rngFirstRow, 0)
Else
result = .Match(text_to_find, rngFirstRow, 0)
End If
If .IsError(result) = False Then
col = CLng(result) 'will need an offset if the range's first column is not 1
End If
End With
If col > 0 Then
GetColumnLetter_ByMatch = GetColumnLetter(col)
End If
End Function
The (very crude) test method (some parameter explanation below):
Public Sub Test_ColumnFinding(Optional testString As String = "yyy", _
Optional numberOfTests As Long = 1000, _
Optional printResults As Boolean = True, _
Optional printEvery As Integer = 10)
Dim rng As Excel.Range
Dim timStart1 As Single, timEnd1 As Single, timTotal1 As Single
Dim timStart2 As Single, timEnd2 As Single, timTotal2 As Single
Dim strTest1 As String, strTest2 As String
Dim i As Long
Set rng = ActiveSheet.Rows(1)
For i = 1 To numberOfTests
timStart1 = Timer
strTest1 = GetColumnLetter_ByFind(rng, testString, IIf(i Mod 3 = 0, XlLookAt.xlPart, XlLookAt.xlWhole))
timEnd1 = Timer
timTotal1 = timTotal1 + (timEnd1 - timStart1)
timStart2 = Timer
strTest2 = GetColumnLetter_ByMatch(rng, testString, IIf(i Mod 3 = 0, XlLookAt.xlPart, XlLookAt.xlWhole))
timEnd2 = Timer
timTotal2 = timTotal2 + (timEnd2 - timStart2)
If printResults Then
If i Mod printEvery = 0 Then
Debug.Print i, "GetColumnLetter_ByFind", strTest1, timEnd1 - timStart1
Debug.Print i, "GetColumnLetter_ByMatch", strTest2, timEnd2 - timStart2
End If
End If
Next i
Debug.Print "GetColumnLetter_ByFind took " & timTotal1 / numberOfTests & " seconds on avg to execute"
Debug.Print "GetColumnLetter_ByMatch took " & timTotal2 / numberOfTests & " seconds on avg to execute"
End Sub
Where testString controls distance to match, numberOfTests the repetition, printResults whether or not to see debug output, and printEvery how often to check in on that output.
My results, for 1000 tests but no result debug output:
GetColumnLetter_ByFind took 0.003546875 seconds on avg to execute
GetColumnLetter_ByMatch took 0.00134375 seconds on avg to execute