Adding calculated columns FAST using variant arrays

create_a_new_column_based_on_a_different_column.vb

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