Instantly share code, notes, and snippets.

Embed
What would you like to do?
Adding calculated columns FAST using variant arrays
Option Explicit
Public Sub CalculateResultsAndAddAsColumn()
Dim rngCategory As Range, rngResults As Range
Dim varCategory As Variant, varResults As Variant
Dim lngIdx As Long, lngLastRow As Long
Dim wksData As Worksheet
Dim strFirstLetter As String
'First things first: let's set up our basic variables
Set wksData = ThisWorkbook.Worksheets("data")
With wksData
'Now that the Worksheet is defined, we'll find the last row number
lngLastRow = .Cells.Find(What:="*", LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
'We can now use a Range to grab all the category data
Set rngCategory = .Range(.Cells(2, 1), .Cells(lngLastRow, 1))
End With
'Since the data file is big, we want to avoid interacting with the sheet.
'Variant arrays to the rescue!
'Set the variant array to the Range we just defined
varCategory = rngCategory
varResults = varCategory
'Let's start looping through the array and checking the first letter
For lngIdx = 1 To UBound(varCategory)
'Get the first letter and start comparing with a Select Case statement
strFirstLetter = UCase(CStr(Left(varCategory(lngIdx, 1), 1)))
Select Case strFirstLetter
Case "A"
varResults(lngIdx, 1) = "Pass"
Case "B"
varResults(lngIdx, 1) = "Fail"
'Case "C", Case "D", Case "E", etc... as demand changes
Case Else
varResults(lngIdx, 1) = "I don't know!"
End Select
Next lngIdx
With wksData
'Prep the Results Range, knowing that it's simply one column over
Set rngResults = .Range(.Cells(2, 2), .Cells(lngLastRow, 2))
'Add a header in preparation for delivery of the Results data
.Cells(1, 2) = "Results"
End With
'Write the Results Variant array to the Results Range and we're done!
rngResults = varResults
'Message the user and let him or her know we're done!
MsgBox "Damn! That was fast!"
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment