Excel VBA Copy PAste using For Loop: Slow Macro Execution

Question

Hi,

I have written For Loop for sending input data to Third Party application from Excel and then third party application runs and sends the output to excel , i is the row number in excel sheet .

But below code takes too much time to process input data and send the output as it has to change between different worksheets for that copy paste. I tried adding value after cells but not good speed still.

How to use any alternate way to resolve this issue . I am getting the code execution in around 455 secs for this macro and i want to make it around 50 secs . Is it possible ?

See the code below :

Dim Start_Date As Date

Dim End_Date As Date

Dim i As Integer

Dim Start_Row As Integer

Dim endrow As Integer

Start_Date = Worksheets("Series").Range("H8")

End_Date = Worksheets("Series").Range("H9")

Worksheets("INPUTOUTPUT").Range("P17") = 1

For i = 18 To 23

If Worksheets("Series").Cells(i, 4) = Start_Date Then

Start_Row = i

ElseIf Worksheets("Series").Cells(i, 4) = End_Date Then

endrow = i

End If

Next i

For i = Start_Row To endrow

'First Input Entry

Worksheets("SeriesData1").Range("AB14").Value = Worksheets("Series").Cells(i, 7).Value

Worksheets("SeriesData1").Range("AB15").Value = Worksheets("Series").Cells(i, 6).Value

Worksheets("SeriesData1").Range("AB16").Value = Worksheets("Series").Cells(i, 5).Value

Worksheets("SeriesData1").Range("AB17").Value = Worksheets("Series").Cells(i, 9).Value

Worksheets("SeriesData1").Range("AB18").Value = Worksheets("Series").Cells(i, 8).Value

'Second Entry

Worksheets("SeriesData1").Range("AB19").Value = Worksheets("Series").Cells(i, 11).Value

Worksheets("SeriesData1").Range("AB20").Value = Worksheets("Series").Cells(i, 10).Value

Worksheets("SeriesData1").Range("AB21").Value = Worksheets("Series").Cells(i, 13).Value

Worksheets("SeriesData1").Range("AB22").Value = Worksheets("Series").Cells(i, 12).Value

'Worksheets("SeriesData1").Range("D13") = Worksheets("Series").Cells(i, 8)

'Worksheets("SeriesData1").Range("D9") = Worksheets("Series").Cells(i, 26)

Answer 1

You may try this code

'''''=================================

Sub InputValues()

Dim Start_Date As Date

Dim End_Date As Date

Dim i As Integer, j As Integer

Dim Start_Row As Integer

Dim End_Row As Integer

Worksheets("INPUTOUTPUT").Range("P17") = 1

With Worksheets("Series")

    Start\_Date = .Range("H8") 

    End\_Date = .Range("H9") 

    For i = 18 To 23 

        If .Cells(i, "D") = Start\_Date Then Start\_Row = i 

        ElseIf .Cells(i, "D") = End\_Date Then End\_Row = i 

       End If 

    Next i 

End With

With Worksheets("SeriesData1")

For j = Start_Row To EndRow

        ''''''Step 1: Input Data processing for particular date 

        'First Input  Entry 

        .Range("AB14").Value = Worksheets("Series").Cells(i, "G").Value 

        .Range("AB15").Value = Worksheets("Series").Cells(i, "F").Value 

        .Range("AB16").Value = Worksheets("Series").Cells(i, "E").Value 

        .Range("AB17").Value = Worksheets("Series").Cells(i, "I").Value 

        .Range("AB18").Value = Worksheets("Series").Cells(i, "H").Value 

        'Second  Entry 

        .Range("AB19").Value = Worksheets("Series").Cells(i, "K").Value 

        .Range("AB20").Value = Worksheets("Series").Cells(i, "J").Value 

        .Range("AB21").Value = Worksheets("Series").Cells(i, "M").Value 

        .Range("AB22").Value = Worksheets("Series").Cells(i, "L").Value 

        .Range("D13").Value = Worksheets("Series").Cells(i, "H").Value 

        .Range("D9").Value = Worksheets("Series").Cells(i, "Z").Value 

        '''' Here you place the code for Steps 2 and 3 

        ''' Step 2: Run Third Party Application 

        '''Step 3: Get the Output and sent it to Excel for that particular date. 

Next j

End Sub

''''=============================================

NOTE: We choose to replace column numbers with their respective letters.

Regards

Jeovany

Answer 2

Hi Sir,

Thanks for your reply.

But with your code, we have not eliminated multiple copy pastes for individual cells. I want to reduce no of such rows here.

In your code, i is row number or j is row number?

Here is my complete existing code now:

Dim Start_Date As Date

Dim End_Date As Date

Dim i As Integer

Dim Start_Row As Integer

Dim endrow As Integer

Start_Date = Worksheets("Series").Range("H8")

End_Date = Worksheets("Series").Range("H9")

For i = 18 To 715

If Worksheets("Series").Cells(i, 4) = Start_Date Then

Start_Row = i

ElseIf Worksheets("Series").Cells(i, 4) = End_Date Then

endrow = i

End If

Next i

For i = Start_Row To endrow

'Step 1

'Input Entry 1

Worksheets("SeriesData1").Range("AB14") = Worksheets("Series").Cells(i, 7)

Worksheets("SeriesData1").Range("AB15") = Worksheets("Series").Cells(i, 6)

Worksheets("SeriesData1").Range("AB16") = Worksheets("Series").Cells(i, 5)

Worksheets("SeriesData1").Range("AB17") = Worksheets("Series").Cells(i, 9)

Worksheets("SeriesData1").Range("AB18") = Worksheets("Series").Cells(i, 8)

'Entry no 2

Worksheets("SeriesData1").Range("AB19") = Worksheets("Series").Cells(i, 11)

Worksheets("SeriesData1").Range("AB20") = Worksheets("Series").Cells(i, 10)

Worksheets("SeriesData1").Range("AB21") = Worksheets("Series").Cells(i, 13)

Worksheets("SeriesData1").Range("AB22") = Worksheets("Series").Cells(i, 12)

'Worksheets("SeriesData1").Range("D13") = Worksheets("Series").Cells(i, 8)

'Worksheets("SeriesData1").Range("D9") = Worksheets("Series").Cells(i, 26)

'Entry no 3

Worksheets("SeriesData1").Range("AB23") = Worksheets("Series").Cells(i, 15)

Worksheets("SeriesData1").Range("AB24") = Worksheets("Series").Cells(i, 14)

Worksheets("SeriesData1").Range("AB25") = Worksheets("Series").Cells(i, 17)

Worksheets("SeriesData1").Range("AB26") = Worksheets("Series").Cells(i, 16)

'Input Entry 4

Worksheets("SeriesData1").Range("AB27") = Worksheets("Series").Cells(i, 19)

Worksheets("SeriesData1").Range("AB28") = Worksheets("Series").Cells(i, 18)

Worksheets("SeriesData1").Range("AB29") = Worksheets("Series").Cells(i, 21)

Worksheets("SeriesData1").Range("AB30") = Worksheets("Series").Cells(i, 20)

'Input Entry 5

Worksheets("SeriesData1").Range("AB31") = Worksheets("Series").Cells(i, 23)

Worksheets("SeriesData1").Range("AB32") = Worksheets("Series").Cells(i, 22)

Worksheets("SeriesData1").Range("AB33") = Worksheets("Series").Cells(i, 25)

Worksheets("SeriesData1").Range("AB34") = Worksheets("Series").Cells(i, 24)

'Input 6

Worksheets("SeriesData1").Range("AB35") = Worksheets("Series").Cells(i, 57)

Worksheets("SeriesData1").Range("AB36") = Worksheets("Series").Cells(i, 58)

Worksheets("SeriesData1").Range("AB37") = Worksheets("Series").Cells(i, 59)

Worksheets("SeriesData1").Range("AB38") = Worksheets("Series").Cells(i, 60)

Worksheets("SeriesData1").Range("AB39") = Worksheets("Series").Cells(i, 61)

'Process Inlet 7

Worksheets("SeriesData1").Range("AB40") = Worksheets("Series").Cells(i, 62)

Worksheets("SeriesData1").Range("AB41") = Worksheets("Series").Cells(i, 63)

Worksheets("SeriesData1").Range("AB42") = Worksheets("Series").Cells(i, 64)

Worksheets("SeriesData1").Range("AB43") = Worksheets("Series").Cells(i, 65)

Worksheets("SeriesData1").Range("AB44") = Worksheets("Series").Cells(i, 66)

'Step 2 :

Application.RUN "'A.xla'!RestartActive"

Application.RUN "'A.xla'!Active"

'Steps 3:

'Output 1

Worksheets("Series").Cells(i, 47) = Worksheets("INPUTOUTPUT").Range("AA87")

Worksheets("Series").Cells(i, 48) = Worksheets("INPUTOUTPUT").Range("AA88")

Worksheets("Series").Cells(i, 49) = Worksheets("INPUTOUTPUT").Range("AA89")

Worksheets("Series").Cells(i, 50) = Worksheets("INPUTOUTPUT").Range("AA90")

'end of code

End Sub

Because of Multiple copy pastes in above code, it is slowing down macro a lot and it is running for large no of dates say like 3 years, it takes hours to complete this code here.

I did not understand completely how your code will make it faster as your code still has large no of lines which will slow down the code a lot.

Here below screenshot of Series Worksheet for your reference. Left side columns are input columns which is step no1 and Step no2 is Output columns on the right side of this worksheet, now.

Please change my existing code for less no of lines using Array and share the code if possible for you.

Answer 3

Kindly suggest preparing and uploading a sample file to Onedrive, Dropbox, etc ... and share the link here.

Please first,

a)  Remove any personal/sensitive data.

b) Keep the headers, table structure, and formulas as they actually are.

c) ZIP the file if contains macros, pictures, shapes, or other objects.

This will help us to give you a prompt and right solution.

If you need help with how to upload the file follow the instructions in this video

https://www.youtube.com/watch?v=NnXsE0SNuCc&t=14s

Regards

Jeovany