Add formula to cells on selection

Question

I am trying to make a code that will switch cells in a line between having a user entered variable or one calculated from a lookup table. I have one that mostly works, but it runs really slowly! So:

• Any suggestions on making this code run faster?

• How can I make it only look at cells where the value in a column (with a Auto/Manual data validation dropdown) is changed?

I've removed the formula from the below as they are a bit long.

Code:

Application.ScreenUpdating = False
Application.AutoCorrect.AutoFillFormulasInLists = False

'define variables
Dim Tbl As Range
Dim RngAuto As Range
Dim TblRows As Integer
Dim i As Integer
Dim cell As Range

Set Tbl = Range(ActiveSheet.ListObjects(1))

TblRows = Tbl.Rows.Count

'MsgBox ("Warning, proceeding will clear all data for this row!")

For i = 1 To TblRows
    If Tbl(i, 8).Text = "Aut" Then 'if set to automatic add formlars to cells
        Tbl(i, 20).FormulaR1C1 = "Formula Here"
        Tbl(i, 20).Interior.ColorIndex = 37

        Tbl(i, 21).FormulaR1C1 = "Formula Here"
        Tbl(i, 21).Interior.ColorIndex = 37

        Tbl(i, 22).FormulaR1C1 = "Formula Here"
        Tbl(i, 22).Interior.ColorIndex = 37

        Tbl(i, 25).FormulaR1C1 = "Formula Here"
        Tbl(i, 25).Interior.ColorIndex = 37

        Tbl(i, 30).FormulaR1C1 = "Formula Here"
        Tbl(i, 30).Interior.ColorIndex = 37

        Tbl(i, 31).FormulaR1C1 = "Formula Here"
        Tbl(i, 31).Interior.ColorIndex = 37

        Tbl(i, 32).FormulaR1C1 = "Formula Here"
        Tbl(i, 32).Interior.ColorIndex = 37

        Tbl(i, 33).FormulaR1C1 = "Formula Here"
        Tbl(i, 33).Interior.ColorIndex = 37

        Tbl(i, 34).FormulaR1C1 = "Formula Here"
        Tbl(i, 34).Interior.ColorIndex = 37

    Else
        Set RngAuto = Application.Union(Tbl(i, 20), Tbl(i, 21), Tbl(i, 22), Tbl(i, 25), Tbl(i, 30), Tbl(i, 31), Tbl(i, 32), Tbl(i, 33), Tbl(i, 34))

        With RngAuto
            .Interior.ColorIndex = 0
            .Select
        End With

        For Each cell In Selection
            cell.Value = cell.Value
        Next cell

    End If

Next i

Application.ScreenUpdating = True

End Sub

Thanks In advance.

Answer 1

I hope the following is a bit faster.

Public Sub AutoUpdate()

Dim strSearchRange As String
Dim strFirstFound As String
Dim intLastRow As Integer
Dim intColumns As Integer
Dim varFound As Variant
Dim RngAuto As Range
Dim cell As Range
Dim Tbl As Range


With Application
    .EnableEvents = False
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .AutoCorrect.AutoFillFormulasInLists = False
End With

strSearchRange = Range(ActiveSheet.ListObjects(1)).Offset(, 7).Resize(, 1).Address
intLastRow = ActiveSheet.ListObjects(1).ListRows.Count + 1

'MsgBox ("Warning, proceeding will clear all data for this row!")

For Each intColumn In Array(20, 21, 22, 25, 30, 31, 32, 33, 34)
    With ActiveSheet
        .Range(.Cells(2, intColumn), .Cells(intLastRow, intColumn)).Interior.ColorIndex = 0
        .Range(.Cells(2, intColumn), .Cells(intLastRow, intColumn)).Value2 = .Range(.Cells(2, intColumn), .Cells(intLastRow, intColumn)).Value2
    End With
Next intColumn

With Worksheets(1).Range(strSearchRange)
    Set varFound = .Find("Aut", LookIn:=xlValues)
    If Not varFound Is Nothing Then
        strFirstFound = varFound.Address
        Do
            ActiveSheet.Range(.Cells(varFound.Row, 20), .Cells(varFound.Row, 22)).FormulaR1C1 = "Formula Here"
            ActiveSheet.Range(.Cells(varFound.Row, 20), .Cells(varFound.Row, 22)).Interior.ColorIndex = 37
            ActiveSheet.Range(.Cells(varFound.Row, 25), .Cells(varFound.Row, 25)).FormulaR1C1 = "Formula Here"
            ActiveSheet.Range(.Cells(varFound.Row, 25), .Cells(varFound.Row, 25)).Interior.ColorIndex = 37
            ActiveSheet.Range(.Cells(varFound.Row, 30), .Cells(varFound.Row, 34)).FormulaR1C1 = "Formula Here"
            ActiveSheet.Range(.Cells(varFound.Row, 30), .Cells(varFound.Row, 34)).Interior.ColorIndex = 37
            Set varFound = .FindNext(varFound)
        Loop While Not varFound Is Nothing And varFound.Address <> strFirstFound
    End If
End With

With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .EnableEvents = True
End With

End Sub

Please note that I haven't been able to test it entirely. So, it might need a little tweaking.

Things I did include (1) turning off the suggested ScreenUpdating and EnableEvents but also Calculation. (2) Using the .Find function instead of looping through all rows. (3) Use .value2 instead of .value. (4) Bulk-change formulas by grouping them together.