Is there a faster way to set cell values with VBA than FOR EACH

user_2867882 0
Viewed 81

At times this range can be tens of thousands of rows for the validation. Currently, in order to set the validation to the correct value for the selection, I am doing a For Each. The following is part of the code where the validation is set.

With BCS.Range("AT2:AT" & Lrow).Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
    xlBetween, Formula1:=BStr
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = True
End With

BCS.Range("AT2:AT" & Lrow).Value = "1"  

ThisWorkbook.Sheets("est_temp").Range("A1:A" & Lrow2).Copy
ThisWorkbook.Sheets("B_C_I").Range("AO2").PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.DisplayAlerts = False
ThisWorkbook.Sheets("est_temp").Delete
Application.DisplayAlerts = True

If Lrow > 2 Then
    For Each c In BCS.Range("AO2:AO" & Lrow)
        With c
            If c.Value = "AA" Then
                Range("AT" & c.Row).Value = "Std % 1"
            ElseIf c.Value = "BB" Then
                Range("AT" & c.Row).Value = "Std % 2"
            Else
                Range("AT" & c.Row).Value = "1"
            End If
        End With
    Next c
End If

For obvious reasons when you have to go through 25000+ rows that takes quite some time. Is there a faster way to do this than the For Each?

vba excel
1 Answers

As @Rory notes - this will be faster:

Dim arr, r As Long

If Lrow > 2 Then
    arr = BCS.Range("AO2:AO" & Lrow).Value 'get all the data in an array
    For r = 1 to UBound(arr, 1)
        Select Case arr(r, 1)
            Case "AA": arr(r, 1) = "Std % 1"
            Case "BB": arr(r, 1) = "Std % 2"
            Case Else: arr(r, 1) = "1"
        End Select
    Next r
    BCS.Range("TO2:TO" & Lrow).Value = arr 'write back to sheet
End If
user_4788840
Related