Macro runs Slowly

Hi

Not sure what you have in your formulas, but see how this goes.

Sub AAA()
  Dim InsertCnt As Long
  InsertCnt = 250
  shtarr = Array("Data Input -Unit Leaders", "Ranking - Unit Leaders")
  For i = LBound(shtarr) To UBound(shtarr)
    Sheets(shtarr(i)).Activate
    ActiveSheet.Unprotect Password:="team"
    actionrow = Cells(Rows.Count, 1).End(xlUp).Offset(-1, 0).Row
    Cells(actionrow, 1).Resize(InsertCnt, 1).EntireRow.Insert shift:=xlDown
    Cells(actionrow + InsertCnt + 2, 1).EntireRow.Copy Destination:=Cells(actionrow, 1).Resize(InsertCnt, 1)
    ActiveSheet.Protect Password:="team"
  Next i
End Sub

rylo

Hi Rylo,

Tried your code but debugs at Sheets (Shtarr(i)).Activate (6th Line)
I see your code is assuming that both sheets are identical which is not the case. Any help here?

Hi

1) check the sheet names. I just took them from your code, but if it isn't right, then it will error.

2) Missed that difference. You could just duplicate the code and specifically nominate the sheet as you have done, as I think the insertion method will still be faster.

Better still, put up an example file for review. Makes things much easier to work through.

rylo

Not tested, but this should be very quick...

Sub InsertRowS1()
    
    With Worksheets("Data Input -Unit Leaders")
        .Activate
        .Unprotect Password:="team"
        .Cells(.Rows.Count, 1).End(xlUp).Offset(2, 0).EntireRow.Copy
        .Cells(.Rows.Count, 1).End(xlUp).Offset(-1, 0).EntireRow.Resize(250).Insert shift:=xlDown
        .Protect Password:="team"
    End With
    
    With Worksheets("Ranking - Unit Leaders")
        .Activate
        .Unprotect Password:="team"
        .Cells(.Rows.Count, 1).End(xlUp).Offset(-2, 0).EntireRow.Copy
        .Cells(.Rows.Count, 1).End(xlUp).Offset(-1, 0).EntireRow.Resize(250).Insert shift:=xlDown
        .Protect Password:="team"
    End With

End Sub

Hi Dangleor

Thanks for your input but the code you are suggesting are only inserting rows and does not copy forumuals.
Please refer to my original code, the macro is inserting and copying formulas only. This it does to both my sheets.
The macro is absolutely fine but i need a code to speed it up.
Thanks

Mysore

really think we need the example file to work with here....

rylo

Hi Guys,

Just Attaching a sample worksheet. I have just revised the macro to loop 2o times for
illustration purpose but the final version will have 250 rows to add and copy formulas.


Hope this helps

Thanks

Hi

I've just tweaked dangelor's code a bit and I think it gives you what you are chasing.

Sub InsertRowS2()
    
    With Worksheets("Data Input -Unit Leaders")
        .Activate
        .Unprotect Password:="team"
        .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow.Copy
        .Cells(.Rows.Count, 1).End(xlUp).Offset(-1, 0).EntireRow.Resize(250).Insert shift:=xlDown
        .Protect Password:="team"
    End With
    
    With Worksheets("Ranking  - Unit Leaders")
        .Activate
        .Unprotect Password:="team"
        .Cells(.Rows.Count, 1).End(xlUp).Offset(-2, 0).EntireRow.Copy
        .Cells(.Rows.Count, 1).End(xlUp).Offset(-1, 0).EntireRow.Resize(250).Insert shift:=xlDown
        .Protect Password:="team"
    End With

End Sub

rylo

Hi Rylo

Thanks for the code. Is is certainly faster. Just one hurdle to cross. The Data Input - Sheet is fully protected but permits
data entry only in specific range. The new rows which are created are locked. My earlier macro did have not this issue.
Maybe when the formula copies, it should copy the formats as well and this could help,
Can you tweak the code?

Thanks

Hi

Give some examples of the ranges so we know exactly what / where to check.

rylo

Hi rylo

Range A8 - DW308 in the Data Input - Unit Leader Sheet in my original file. Infact you look at my attachment and run the macro.
This might give u an understadning

Try...

Sub InsertRowS3()

    With Worksheets("Data Input -Unit Leaders")
        .Activate
        .Unprotect Password:="team"
        With .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow
            .Cells.Locked = False
            .Copy
        End With
        .Cells(.Rows.Count, 1).End(xlUp).Offset(-1, 0).EntireRow.Resize(250).Insert shift:=xlDown
        .Protect Password:="team"
    End With

    With Worksheets("Ranking  - Unit Leaders")
        .Activate
        .Unprotect Password:="team"
        .Cells(.Rows.Count, 1).End(xlUp).Offset(-2, 0).EntireRow.Copy
        .Cells(.Rows.Count, 1).End(xlUp).Offset(-1, 0).EntireRow.Resize(250).Insert shift:=xlDown
        .Protect Password:="team"
    End With

End Sub

Hi Dangelor,

I used the above code but it groups the newly inserted rows since the row where it copies the formula is grouped.
This cannot be ungrouped by the user as the worksheet is protected.
Please refer to the original file I have attached and the macro does not group the new insertion .

Appreciate if you can tweak it.

Thanks

Tweaked...

Sub InsertRowS4()

    With Worksheets("Data Input -Unit Leaders")
        .Activate
        .Unprotect Password:="team"
        With .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow
            .Cells.Locked = False
            .Ungroup
            .Copy
            .Group
        End With
        .Cells(.Rows.Count, 1).End(xlUp).Offset(-1, 0).EntireRow.Resize(250).Insert
        .Protect Password:="team"
    End With

        With Worksheets("Ranking  - Unit Leaders")
            .Activate
            .Unprotect Password:="team"
            .Cells(.Rows.Count, 1).End(xlUp).Offset(-2, 0).EntireRow.Copy
            .Cells(.Rows.Count, 1).End(xlUp).Offset(-1, 0).EntireRow.Resize(250).Insert shift:=xlDown
            .Protect Password:="team"
        End With

End Sub

Hi Rylo,

Did you get a chance to have a look at it?

Hi

You will have to change the row that you are copying (on the first sheet row 311 in the example file) to have to correct cell permissions. Otherwise, you will have to change the row that you want to use as the base row to copy. Given you have drop downs as well, it may pay to put those into the main copy row as well.

rylo