Improving the speed of a Loop's performance?

Question

I currently have to workbooks, Test 1 (the name of the first workbook where the code is written) and Test 2 (where values are pasted into from Test 1). My current code takes the values from Rows K1-K10 (Column 11, Rows 1-10) from the Test 1 workbook and pastes them into Columns F2-P2 (Row 2, Columns 6-16) of the Test 2 workbook (THE FIRST CODE IS WORKING).

I am trying to make this code run faster as when I use it for my other applications, I feel as if the loop makes it laggy and sluggish. I am trying to replace the Do (While) Loop with a Double (For) Loop statement. Please let me know if you have a suggestion as my Double (For) Loop is not pasting any values into the Test 2 workbook (Also how do I measure the time it takes for each function to run).

Here are both codes and screenshots as well for visual aid:

Private Sub CommandButton1_Click()

Dim y As Workbook
Dim i As Integer
Dim j As Integer
i = 6
j = 1

Set y = Workbooks.Open(Filename:="\\FILEPATH\Databases\Test 2.xlsm", Password:="Swarf")

    With y



        Do While j <= 11
            If (Cells(j, 11).Value <> "") Then

                .Sheets("MyTest2").Unprotect "Swarf"
                .Sheets("Mytest2").Cells(2, i).Value = Sheet1.Cells(j, 11).Value

            End If

        i = i + 1
        j = j + 1

        Loop



        .Password = "Swarf"
        .Save
        .Close False

    End With


End Sub

Here is my attempted code at a Double (for) Loop:


Private Sub CommandButton1_Click()

Dim y As Workbook
Dim i As Integer
Dim j As Integer

Set y = Workbooks.Open(Filename:="\\FILEPATH\Databases\Test 2.xlsm", Password:="Swarf")

    With y

        For i = 6 To 16
          For j = 1 To 10


            If (Cells(i, 11).Value <> "") Then

                .Sheets("MyTest2").Unprotect "Swarf"
                .Sheets("Mytest2").Cells(2, i).Value = Sheet1.Cells(j, 11).Value

            End If

          Next j
        Next i

        .Password = "Swarf"
        .Save
        .Close False

    End With


End Sub

You only need to unprotect the sheet once. do it outside the loop. If your code works and you just want to improve it, then this question may be better suited to https://codereview.stackexchange.com/ — cybernetic.nomad, Dec 04 '19 at 15:51
Are you just transposing values? If so, there's no need for any loop at all. — BigBen, Dec 04 '19 at 15:53
In the first case (while), in each loop, both i and j are incremented once, so there will be 11 runs. in the second case (for), you have two loops one inside the other, so you will have 11 (j=1->11) x 11 (i=6->16) runs. They don't do the same thing, and I doubt the second one can be faster. — Vincent G, Dec 04 '19 at 15:56
@cybernetic.nomad I appreciate the suggestion but my second code is not working so that's why I posted it here. and would I just put " .Sheets("MyTest2").Unprotect "Swarf" " just above the with statement or above Do While? — Handreen, Dec 04 '19 at 15:56
Range `K1-K10` contains 10 cells and you are pasting them into range `F2-P2`, which is 11 cells...Anyways, why don't you just copy the 10/11 values and then paste them transposed into cell `F2`? — Foxfire And Burns And Burns, Dec 04 '19 at 15:59
If you want it faster, don't copy data cell by cell, copy them by bloc. — Vincent G, Dec 04 '19 at 15:59
@Handreen `.Sheets("MyTest2").Unprotect "Swarf"` the `.` at the beginning means it is being referenced by a `With` statement, so it needs to go just after the `With` for example. — Damian, Dec 04 '19 at 16:00
@BigBen Yes essentially I am transposing values now that I think about it, is there an easier way to do this? — Handreen, Dec 04 '19 at 16:00
I fully agree with @BigBen here, transposing doesn't have to be done with a loop. If you do insist doing it this way, you should put `application.screenupdating = false` at the start and `application.screenupdating = true` at the end of your code. This will stop displaying everything you do on screen until it is done, which will increase performance. — Plutian, Dec 04 '19 at 16:01
@Handreen you can `.Copy` and then `.PasteSpecial xlPasteValues, Transpose:=True` and that would do it. — Damian, Dec 04 '19 at 16:01
[Copy](https://learn.microsoft.com/en-us/office/vba/api/excel.range.copy) then [PasteSpecial](https://learn.microsoft.com/en-us/office/vba/api/excel.range.pastespecial) with the transpose argument? Or Copy to an array, [Transpose](https://learn.microsoft.com/en-us/office/vba/api/excel.worksheetfunction.transpose) the array, and then copy back? — Vincent G, Dec 04 '19 at 16:04
Hint: `destination.Range("F2:O2") = Application.Transpose(source.Range("K1:K10"))`, given destination and source are set to the right (unprotected) worksheets. — Vincent G, Dec 04 '19 at 16:12
@Plutian Do I just put the application.screenupdating=false right after my Private Sub and the application.screenupdating=true right before my End sub? and I am having a hard time writing the function to transpose for some reason — Handreen, Dec 04 '19 at 16:23
@VincentG how would I incorporate that into my code and remove the loop statement? would you mind showing me, thanks in advance — Handreen, Dec 04 '19 at 16:27
Anywhere before your first operation will do. Common practise is to put it just after your `Dim` statements, and the `True` one just before `End Sub` — Plutian, Dec 04 '19 at 16:27
@Damian I currently have ~~~Private Sub CommandButton1_Click() Application.ScreenUpdating = False Dim y As Workbook Set y = Workbooks.Open(Filename:="\\schaeffler.com\stratford\DATA\NEA-FBA-P\Projects\SetupSheets\Databases\Test 2.xlsm", Password:="Swarf") With y Sheets("MyTest2").Unprotect "Swarf" .Sheet1.Range("K1:K10").Copy .Sheets("Mytest2").Range("F2-P2").PasteSpecial xlPasteValues, Transpose:=True Password = "Swarf" .Save .Close False End With Application.ScreenUpdating = True End Sub — Handreen, Dec 04 '19 at 16:28
@Plutian thank you for clarifying what the common practice is, could you please let me know what the code is supposed to look like by just simply transposing in my case? — Handreen, Dec 04 '19 at 16:29
It doesn't seem to be that slow. Remove some dots. See https://stackoverflow.com/questions/29596432/pointers-needed-for-speeding-up-nested-loop-macro-in-vba/29597193#29597193 — , Dec 04 '19 at 17:44

score 2 · Accepted Answer · answered Dec 04 '19 at 16:32

2

To much code to write in a comment, but here you go:

Private Sub CommandButton1_Click()

    With Workbooks.Open(Filename:="\\FILEPATH\Databases\Test 2.xlsm", Password:="Swarf").Sheets("MyTest2")
        .Unprotect "Swarf"
        .Range("F2:O2") = Application.Transpose(Sheet1.Range("K1:K10"))
        .Protect "Swarf"
        .Password = "Swarf"
        .Save
        .Close False
    End With
End Sub

Not sure about the Protect / Password thing.

answered Dec 04 '19 at 16:32

Vincent G

3,153
1
13
30

The password seems to be giving me some type of error, any solutions to this? – Handreen Dec 04 '19 at 16:41
I have just slightly modified your code, thank you for the help – Handreen Dec 04 '19 at 18:26

score 0 · Answer 2 · answered Dec 04 '19 at 18:30

This is @Vincent G answer slightly modified (I have accepted his answer)- just fixed the password error I was getting, I am now using this code and it is working flawlessly!

Leaving this here incase someone else reads this post and wants to know what the end result of everyone's suggestions is, thanks to everyone who contributed.

Private Sub CommandButton1_Click()

Dim y As Workbook

Application.ScreenUpdating = False

Set y = Workbooks.Open(Filename:="\\FILEPATH\Databases\Test 2.xlsm", Password:="Swarf")

    With y
        Sheets("MyTest2").Unprotect "Swarf"

        .Sheets("Mytest2").Range("F2:O2") = Application.Transpose(Sheet1.Range("K1:K10"))

        Password = "Swarf"
        .Save
        .Close False

    End With

Application.ScreenUpdating = True

End Sub

Improving the speed of a Loop's performance?

2 Answers2