0

I need to insert rows in a worksheet.

I have to insert around 350 rows based on some condition and it takes around 30-40 minutes.

Below is my VBA code:

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

For index = CardetailInfoStartRow To (CardetailInfoStartRow + CardetailRecordCount - 1)
    If IsError(CardetailDistance) = False Then
        If Len(Trim(CardetailDistance)) > 0 Then                    
            Sheets("Cars").Rows(rowIndexToInsert).Insert Shift:=xlDown
            Sheets("Cars").Range("B" & rowIndexToInsert & ":EA" & _
              rowIndexToInsert).Value = "Cardetail " & _
              Sheets("Cars").Range("I" & index).Value & ", " & CardetailDistance
            Sheets("Cars").Range("B" & rowIndexToInsert & ":EA" & rowIndexToInsert).Select
            With Selection
                .VerticalAlignment = xlTop
                .WrapText = True
                .Orientation = 0
                .AddIndent = False
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = True
                .RowHeight = 23                                
            End With
            rowIndexToInsert = rowIndexToInsert + 1
        End If
    End If
Next index

The sheet contains some conditionally formatted cells.

Going through some of the solutions, there was this solution to disable the conditional formatting. I tried using VBA and still the performance has not improved. Below code was inserted before the method execution.

Range("F1:EA" & Range("car_count").Value - 1).Select
Selection.Interior.ColorIndex = xlNone
Selection.Cells.FormatConditions.Delete

Would there be any alternatives to improve the performance?

braX
  • 11,506
  • 5
  • 20
  • 33
user2081126
  • 77
  • 1
  • 11
  • 1
    You should avoid `Select` in your code , [here](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) is how to. – Storax Jan 01 '20 at 15:24
  • Thanks @Storax: Yes, I tried that as well. But the code still takes around 30 min to execute. – user2081126 Jan 01 '20 at 16:17
  • Find a way to do it which doesnt involve doing it inside a loop. – braX Jan 01 '20 at 17:41
  • 1
    You could copy all data to an array and then do all the looping and processing in the array and then in one command place it all back in the sheet with something like `Range(„A1“).resize(5000,10).value = my_array` – Alex L Jan 01 '20 at 18:15
  • Just small question (for my undersatnding...) What is the value of `CardetailInfoStartRow / CardetailRecordCount` and initial value of `rowIndexToInsert`? – Siddharth Rout Jan 01 '20 at 18:20
  • 4
    Your code seems to be inserting a contiguous block of rows. If that's the case, count the number of rows to insert in the loop, then do the insert ( and format ) in one operation each at the end – chris neilsen Jan 01 '20 at 20:49
  • @SiddharthRout: Initital value for CardetailInfoStartRow is 25 and CardetailRecordCount can vary from 50 to 350. rowIndexToInsert is 200 – user2081126 Jan 02 '20 at 05:07
  • ok great. one last question... (I should have asked it with the rest) `rowIndexToInsert` will always be greater than `CardetailRecordCount`? – Siddharth Rout Jan 02 '20 at 05:09
  • It depends. It can be both the case. – user2081126 Jan 02 '20 at 05:13
  • @chrisneilsen Thanks. The idea of inserting rows all together worked. I am posting the out come in answers. It now takes just one minute to process – user2081126 Jan 02 '20 at 10:12

1 Answers1

0

Based on the comments, I was able to implement the solution for this. Instead of inserting Rows one by one, a single insert was done by taking the count of number of Rows that needs to be inserted. This now takes less than a minute to execute

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

If CarDetailInfoStartRow > 0 And CarDetailRecordCount > 0 Then
            Dim recCount As Integer
            recCount = 0

            For index = CarDetailInfoStartRow To (CarDetailInfoStartRow + CarDetailRecordCount - 1)
                CarDetailSplitLimit = Sheets("Cars").Range("BF" & index).Value
                If IsError(CarDetailSplitLimit) = False And Len(Trim(CarDetailSplitLimit)) > 0 Then
                    recCount = recCount + 1
                End If
            Next index
            If recCount > 0 Then
                Sheets("Cars").Rows(rowIndexToInsert).EntireRow.Offset(1).Resize(recCount).Insert Shift:=xlDown
            End If


For index = CardetailInfoStartRow To (CardetailInfoStartRow + CardetailRecordCount - 1)
 If IsError(CardetailDistance) = False Then
                    If Len(Trim(CardetailDistance)) > 0 Then                    
                        Sheets("Cars").Rows(rowIndexToInsert).Insert Shift:=xlDown
                        Sheets("Cars").Range("B" & rowIndexToInsert & ":EA" & rowIndexToInsert).Value = "Cardetail " & Sheets("Cars").Range("I" & index).Value & ", " & CardetailDistance
                        Sheets("Cars").Range("B" & rowIndexToInsert & ":EA" & rowIndexToInsert).Select
                        With Selection
                            .VerticalAlignment = xlTop
                            .WrapText = True
                            .Orientation = 0
                            .AddIndent = False
                            .ShrinkToFit = False
                            .ReadingOrder = xlContext
                            .MergeCells = True
                            .RowHeight = 23

                        End With
                        rowIndexToInsert = rowIndexToInsert + 1
                    End If
                End If
            Next index
user2081126
  • 77
  • 1
  • 11