VBA Code to Insert Columns & Formula Incredibly Slow - What can be done to make more efficient?

[aeg565]

I'm using the code below to insert a new column to the right of an existing column (based on existing column's name). The code then inserts an equation from the second row to the last row.

The first half (with the vlookup) works fine. However the second half (with the int formula) causes the system to hang and can take up to 5-10 minutes to complete.

What can be done to make this code more efficient? Thanks in advance!

Sub VM_PO_InsertCol()Dim Lastrow As Long


Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False


Lastrow = Range("A" & Rows.Count).End(xlUp).Row


For i = 1 To 14
If Cells(1, i).Value = "Vendor account" Then
Cells(1, i + 1).EntireColumn.Insert
Cells(1, i + 1).Value = "Vendor Class"
Cells(1, i + 1).Interior.Color = RGB(155, 187, 89)
Cells(1, i + 1).EntireColumn.NumberFormat = "0.0"
For j = 1 + 1 To Lastrow
Cells(j, i + 1).Formula = "=IFERROR(vlookup([@[Vendor account]],'Vendor Mapping'!A:I,9,0),""Inactive"")"
Next j
ElseIf Cells(1, i).Value = "Created date and time" Then
Cells(1, i + 1).EntireColumn.Insert
Cells(1, i + 1).Value = "Created date and time (NO TS)"
Cells(1, i + 1).Interior.Color = RGB(155, 187, 89)
Cells(1, i + 1).EntireColumn.NumberFormat = "m/d/yyyy"
For j = 1 + 1 To Lastrow
Cells(j, i + 1).Formula = "=INT([@[Created date and time]])"
Next j
End If


Next i

End Sub

 

[rlv01]

Try turning off calculation while you are inserting new formulas.

    Application.Calculation = xlCalculationManual
    '
    ' insert new columns and formulas
    '
    Application.Calculation = xlCalculationAutomatic

 

[njimack]

The below should run a bit faster as it writes the formula to the entire range rather than looping through each cell. It might be faster still if you only format the relevant cells rather than entire columns...

Sub VM_PO_InsertCol()
Dim Lastrow, i, j As Long

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    .DisplayStatusBar = False
    .EnableEvents = False
    .DisplayPageBreaks = False
End With
Lastrow = Range("A" & Rows.Count).End(xlUp).row
 

 For i = 1 To 14
    With Cells(1, i)
        Select Case .Value
            Case "Vendor account":
            .Value = "Vendor Class"
            .Interior.Color = RGB(155, 187, 89)
            .EntireColumn.NumberFormat = "0.0"
            
            Range(Cells(2, 2), Cells(2, Lastrow)).Formula = "=IFERROR(vlookup([@[Vendor account]],'Vendor Mapping'!A:I,9,0),""Inactive"")"
        
            Case "Created date and time":
            .EntireColumn.Insert
            .Value = "Created date and time (NO TS)"
            .Interior.Color = RGB(155, 187, 89)
            .EntireColumn.NumberFormat = "m/d/yyyy"
    
            Range(Cells(2, 2), Cells(2, Lastrow)).Formula = "=INT([@[Created date and time]])"
        End Select
    End With
 Next i
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    .DisplayStatusBar = True
    .EnableEvents = True
    .DisplayPageBreaks = True
End With

 End Sub