Would love some help to speed up my code...

[Novelec]

Hi guru's,

I'm working on a bit of code to add a new row to a worksheet. The worksheet is for values related to electricity distribution. This particular code adds a new row to a list of equipment that is connected to a particular switchboard. When new equipment is added, the user will add the details to a new row using this button. Previously we've had issues with people accidentally deleting or altering formulas in cells when trying to add new rows, hence the creation of this code.

I'm a VBA novice at best, however from lots of searching on here, I have managed to create the code below. It does exactly what I need. It gets a bit complicated because of the cells that could potentially be surrounding the new row, so I have added formulas and cell formatting to the code for the new line. My only problem is that it takes a few seconds to process all of the code, however ideally it would run "instantly".

I think my problem is that I often refer to an entire row, which obviously takes more time for the program to work through.

Could anyone make any suggestions to speed up my code? As I say, the functionality is exactly as I want it, I am just hoping to make it run faster. Code is shown below.

Any help would be greatly appreciated.

Function InRange(Range1 As Range, Range2 As Range) As Boolean


Dim InterSectRange As Range
        
        Set InterSectRange = Application.Intersect(Range1, Range2)
        
        InRange = Not InterSectRange Is Nothing
        
        Set InterSectRange = Nothing
        
End Function


Sub F_DB1_Insert_New_Rows()


Application.ScreenUpdating = False


Dim Cell As Range


'Insert new row and apply formulas for cells with kVA, KW, and highest phase load


    With Range("F_DB1_Range")
        .Rows(.Rows.Count).EntireRow.Insert
        .Resize(.Rows.Count, .Columns.Count).Name = .Name.Name
        .Rows(.Rows.Count - 1).EntireRow.Select
        Range("L" & Selection.Row).FormulaR1C1 = "=(((RC[-5]+RC[-4]+RC[-3])/3)*415*1.732)/1000"
        Range("M" & Selection.Row).FormulaR1C1 = "=(((RC[-6]+RC[-5]+RC[-4])/3)*415*1.732*0.95)/1000"
        Range("N" & Selection.Row).FormulaR1C1 = "=MAX(RC[-7]:RC[-5])"
    End With
    
'White out new cells that are added which will contain values


    For Each Cell In Selection
    
        If Cell.Interior.Color = RGB(250, 191, 143) Or Cell.Interior.Color = RGB(255, 255, 255) Then
        
            If InRange(Cell, Range("F_DB1_Range")) Then
            
                Cell.Interior.Color = xlNone
            
                With Cell.Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlMedium
                End With
                With Cell.Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
                With Cell.Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
                With Cell.Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlMedium
                End With
                
            End If
            
        End If
        
    Next Cell


'Grey out white cells that are added between top and bottom rows of breaker ratings


    With Range("F_DB1_Totals")
        .Rows(.Rows.Count - 1).EntireRow.Select
    End With
    
    For Each Cell In Selection


        If InRange(Cell, Range("F_DB1_Totals")) Then
        
            Cell.Interior.Color = RGB(191, 191, 191)
            
            With Cell
                .Borders.LineStyle = xlNone
            End With
        
        End If
        
    Next Cell
    
'Set borders for breaker rating and breaker rating percent, bottom row
    
    With Range("F_DB1_Totals")
        .Rows(.Rows.Count).EntireRow.Select
    End With
    
    For Each Cell In Selection


        If InRange(Cell, Range("F_DB1_Totals")) Then
                    
                With Cell.Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlMedium
                End With
                With Cell.Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlMedium
                End With
                With Cell.Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlMedium
                End With
                With Cell.Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlMedium
                End With
        
        End If
        
    Next Cell
    
'Set borders for breaker rating and breaker rating percent, top row
    
    With Range("F_DB1_Totals")
        .Rows(.Rows.Count - .Rows.Count + 1).EntireRow.Select
    End With
    
    For Each Cell In Selection


        If InRange(Cell, Range("F_DB1_Totals")) Then
                    
                With Cell.Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlMedium
                End With
                With Cell.Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlMedium
                End With
                With Cell.Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlMedium
                End With
                With Cell.Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlMedium
                End With
        
        End If
        
    Next Cell


'Update formulas for R/W/B/N totals


    'R totals
    First_Row_R_Amps = Range("F_DB1_R_Amps").Row
    Last_Row_R_Amps = Range("F_DB1_R_Amps").End(xlDown).Offset(-1, 0).Row
    Range("F_DB1_R_Amps_Total") = "=Sum(G" & First_Row_R_Amps & ":G" & Last_Row_R_Amps & ")"


    'W totals
    First_Row_W_Amps = Range("F_DB1_W_Amps").Row
    Last_Row_W_Amps = Range("F_DB1_W_Amps").End(xlDown).Offset(-1, 0).Row
    Range("F_DB1_W_Amps_Total") = "=Sum(H" & First_Row_W_Amps & ":H" & Last_Row_W_Amps & ")"


    'B totals
    First_Row_B_Amps = Range("F_DB1_B_Amps").Row
    Last_Row_B_Amps = Range("F_DB1_B_Amps").End(xlDown).Offset(-1, 0).Row
    Range("F_DB1_B_Amps_Total") = "=Sum(I" & First_Row_B_Amps & ":I" & Last_Row_B_Amps & ")"


    'N totals
    First_Row_N_Amps = Range("F_DB1_N_Amps").Row
    Last_Row_N_Amps = Range("F_DB1_N_Amps").End(xlDown).Offset(-1, 0).Row
    Range("F_DB1_N_Amps_Total") = "=Sum(J" & First_Row_N_Amps & ":J" & Last_Row_N_Amps & ")"


'Select new row that has been inserted


    With Range("F_DB1_Range")
        .Rows(.Rows.Count - 1).EntireRow.Select
    End With


    Application.ScreenUpdating = True


End Sub

 

[xenou]

You could try setting calc to manual too:

at start:

Dim myCalc As Long
myCalc = Application.Calculation
Application.Calculation = xlCalculationManual

At end:

Application.Calculation = myCalc

Code with cell formatting instructions in it sometimes just takes longer, as with print settings. You want to minimize that as much as possible.