Inserting blank rows now running very slow

Originally Posted by Excel_vba

This block of code inserts a blank row at every change in column A.

The way the question is posted might be an event code? If thats the case I would just add one more thing to the amazing code Trebor76 provided.

Option Explicit
Sub Macro1()

    Dim lngMyRow As Long
    Dim xlnCalcMethod As XlCalculation
    
    With Application
        xlnCalcMethod = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    For lngMyRow = Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
        If Range("A" & lngMyRow) <> Range("A" & lngMyRow).Offset(-1, 0) Then
           Range("A" & lngMyRow).EntireRow.Insert
        End If
    Next lngMyRow
    
    With Application
        .Calculation = xlnCalcMethod
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

Thanks