How to make this VBA code become automized and improve its running time?

Question

I developed a VBA code that can fill column B when column A is filled, at first the VBA code runs fast but when the number of cells filled is large the VBA code becomes very slow, how can I make the code run more efficiently so that it is no longer slow? I also want to make the code run automatically without having to create a shortcut to run the macro, so that every time new data is inputted in column A, column B will be filled in automatically. Here is my code

Sub CodeMaster_PipingTagSection()
    Dim lastrow As Long
    Dim i As Long
    
    lastrow = ActiveSheet.Range("I" & Rows.Count).End(xlUp).Row
    
    For i = 7 To lastrow
        If Not IsEmpty(Cells(i, 9)) Then
            Cells(i, 6) = "TEMPERATE"
            Cells(i, 11) = Split(Cells(i, 9), "-")(UBound(Split(Cells(i, 9), "-")))
            Cells(i, 34) = "Three_Layer_PE_or_PP"
            Cells(i, 38) = "N"
            Cells(i, 41) = "N"
            Cells(i, 45) = "Review by Process SME"
            Cells(i, 54) = "False"
            Cells(i, 55) = "1"
            Cells(i, 56) = "N"
            Cells(i, 70) = "Piping"
            Cells(i, 71) = "PIPE"
            Cells(i, 75) = "Criticality RBI Component - Piping"
            Cells(i, 76) = "Non Intrusive"
            Cells(i, 83) = "True"
            Cells(i, 84) = "True"
            Cells(i, 85) = "N"
            Cells(i, 87) = "N"
            Cells(i, 88) = "N"
            Cells(i, 89) = "Visual Detection"
            Cells(i, 90) = "Manual Shutdown"
            Cells(i, 91) = "Inventory blowdown"
            Cells(i, 96) = "100"
            Cells(i, 98) = "False"
            Cells(i, 102) = "False"
        ElseIf IsEmpty(Cells(i, 9)) Then
            Cells(i, 6).ClearContents
            Cells(i, 11).ClearContents
            Cells(i, 34).ClearContents
            Cells(i, 38).ClearContents
            Cells(i, 41).ClearContents
            Cells(i, 45).ClearContents
            Cells(i, 54).ClearContents
            Cells(i, 55).ClearContents
            Cells(i, 56).ClearContents
            Cells(i, 70).ClearContents
            Cells(i, 71).ClearContents
            Cells(i, 75).ClearContents
            Cells(i, 76).ClearContents
            Cells(i, 83).ClearContents
            Cells(i, 84).ClearContents
            Cells(i, 85).ClearContents
            Cells(i, 87).ClearContents
            Cells(i, 88).ClearContents
            Cells(i, 89).ClearContents
            Cells(i, 90).ClearContents
            Cells(i, 91).ClearContents
            Cells(i, 96).ClearContents
            Cells(i, 98).ClearContents
            Cells(i, 102).ClearContents
        End If
    Next i
End Sub

to speed up the code I have tried turning off screen updating by input this code

Sub Stop_Events()
    Application.EnableEvents = False
    '...Statemets
    Application.EnableEvents = True
End Sub

but it still running slow, I need another ways to make this VBA running fast and automatically

The dup gives you hints for more things to disable, but perhaps the most useful answer in your case is [this one about copying cells to arrays](https://stackoverflow.com/a/59914140/1270789) as you have a long set of cell assignments. (A simple minor speedup would be to change your `ElseIf` to just `Else`) — Ken Y-N, May 15 '23 at 02:24

score 1 · Accepted Answer · answered May 15 '23 at 02:25

try

Sub SpeedUpCode()
    Dim lastrow As Long
    Dim data As Variant
    Dim i As Long
    
    lastrow = ActiveSheet.Cells(Rows.Count, "I").End(xlUp).Row
    data = ActiveSheet.Range("A7:CX" & lastrow).Value 'column 102-CX
    
    For i = 1 To UBound(data)
        If Not IsEmpty(data(i, 9)) Then
            data(i, 6) = "TEMPERATE"
            data(i, 11) = Split(data(i, 9), "-")(UBound(Split(data(i, 9), "-")))
            data(i, 34) = "Three_Layer_PE_or_PP"
            data(i, 38) = "N"
            data(i, 41) = "N"
            data(i, 45) = "Review by Process SME"
            data(i, 54) = "False"
            data(i, 55) = "1"
            data(i, 56) = "N"
            data(i, 70) = "Piping"
            data(i, 71) = "PIPE"
            data(i, 75) = "Criticality RBI Component - Piping"
            data(i, 76) = "Non Intrusive"
            data(i, 83) = "True"
            data(i, 84) = "True"
            data(i, 85) = "N"
            data(i, 87) = "N"
            data(i, 88) = "N"
            data(i, 89) = "Visual Detection"
            data(i, 90) = "Manual Shutdown"
            data(i, 91) = "Inventory blowdown"
            data(i, 96) = "100"
            data(i, 98) = "False"
            data(i, 102) = "False"
        ElseIf IsEmpty(data(i, 9)) Then
            data(i, 6) = ""
            data(i, 11) = ""
            data(i, 34) = ""
            data(i, 38) = ""
            data(i, 41) = ""
            data(i, 45) = ""
            data(i, 54) = ""
            data(i, 55) = ""
            data(i, 56) = ""
            data(i, 70) = ""
            data(i, 71) = ""
            data(i, 75) = ""
            data(i, 76) = ""
            data(i, 83) = ""
            data(i, 84) = ""
            data(i, 85) = ""
            data(i, 87) = ""
            data(i, 88) = ""
            data(i, 89) = ""
            data(i, 90) = ""
            data(i, 91) = ""
            data(i, 96) = ""
            data(i, 98) = ""
            data(i, 102) = ""
        End If
    Next i
    
    ActiveSheet.Range("A7:CX" & lastrow).Value = data
End Sub

How to make this VBA code become automized and improve its running time?

1 Answers1