How to speed up the for - next statement using always the last 200 rows that contains text of a column

[Jirka79]

Hi, in order to speed up my attached code, I would like to loop (for - next) only the last 200 rows instead to loop all the ranges AA:AA and L:L. How could I do that?

Please, note that the data from Production data.xlsm is increasing every day and the code selects the ranges with an "X" in columns AA and then goes to the workbook All data.xlsm and according to the last value in column L, pastes the new data. Therefore is never overwriting the previous data.

I assume that the part of the code that I need to change is here:

StRo = .Range("AA:AA").Find("X").Row

and here?

If .Range("AA" & T) = "X" Then

How I can set the first AA in order to be 100 row less than the maximum range containing data?

Then, the same thing I would need to check only the last 200 rows of column L

Here you can see the whole range:

Sub transferDATA()

Dim StRo As Integer, T As Integer, Ro2 As Integer, Lr As Integer

If Range("AA1").Value = 1 Then

Application.ScreenUpdating = False
Application.EnableEvents = False
Workbooks("Production data.xlsm").Worksheets("Production").Activate
ActiveSheet.Unprotect Password:="123"
With Sheets("Production")
M = Workbooks("All data.xlsm").Worksheets("TransferedDATA").UsedRange.Rows.Count

If Workbooks("All data.xlsm").Worksheets("TransferedDATA").UsedRange.Rows.Count = 1 Then
.Range("A4:Z4").Copy Workbooks("All data.xlsm").Worksheets("TransferedDATA").Range("A4")
StRo = .Range("AA:AA").Find("X").Row
Lr = 4
Else
Lr = Workbooks("All data.xlsm").Worksheets("TransferedDATA").Range("L" & Rows.Count).End(xlUp).Row
StRo = .Range("L:L").Find(Workbooks("All data.xlsm").Worksheets("TransferedDATA").Range("L" & Lr)).Row + 1
End If

For T = StRo To .Range("A" & Rows.Count).End(xlUp).Row
    If .Range("AA" & T) = "X" Then
    Ro2 = Ro2 + 1
    Workbooks("All data.xlsm").Worksheets("TransferedDATA").Range("A" & Lr + Ro2 & ":Z" & Lr + Ro2).Value = .Range("A" & T & ":Z" & T).Value
    End If
      
Next T

End With
Application.ScreenUpdating = True
Application.EnableEvents = True

Workbooks("All data.xlsm").Worksheets("TransferedDATA").Activate
Else
Exit Sub
End If

End Sub

Thank you in advance for your support!

 

[Micron]

lngLRow = Range("D2:E" & Cells(Rows.count, "D").End(xlUp).Row)
In the above, the count will start at row 2 of D and return the number that is the last row with data in that column. Once you have your number from an expression like that, a counter loop should start at whatever number you want. If that's 100 less than the last row with data then
lngLRow = 100 - Range("D2:E" & Cells(Rows.count, "D").End(xlUp).Row)
Same idea for your column L. Note that if your rows goes beyond 32767 (I believe) your code will fail by using integer for row count variable.

 

[Jirka79]

lngLRow = Range("D2:E" & Cells(Rows.count, "D").End(xlUp).Row)
In the above, the count will start at row 2 of D and return the number that is the last row with data in that column. Once you have your number from an expression like that, a counter loop should start at whatever number you want. If that's 100 less than the last row with data then
lngLRow = 100 - Range("D2:E" & Cells(Rows.count, "D").End(xlUp).Row)
Same idea for your column L. Note that if your rows goes beyond 32767 (I believe) your code will fail by using integer for row count variable.

Hi Micron,

Thanks for your answer... but the thing is that I don't know how to change it in my code.... Which is the line I need to change? Is this one?

Lr = Workbooks("All data.xlsm").Worksheets("TransferedDATA").Range("L" & Rows.Count).End(xlUp).Row

Or this one?

For T = StRo To .Range("A" & Rows.Count).End(xlUp).Row

And the row will go up to 12000 max, so, no worries to reach the Excel limit of rows

 

[Micron]

I have to go out in 1/2 hour so best I can do for now is fix your indentation, the lack of which makes it hard for me to associate. If you want to post a file somewhere (not allowed in this forum) that might make it easier to associate code parts with sheet parts. Or maybe when I indent I'll be able to do that later.

Sub transferDATA()
Dim StRo As Integer, T As Integer, Ro2 As Integer, Lr As Integer

If Range("AA1").Value = 1 Then
   Application.ScreenUpdating = False
   Application.EnableEvents = False
   Workbooks("Production data.xlsm").Worksheets("Production").Activate
   ActiveSheet.UnProtect Password:="123"
     
   With Sheets("Production")
       m = Workbooks("All data.xlsm").Worksheets("TransferedDATA").UsedRange.Rows.Count
     
       If Workbooks("All data.xlsm").Worksheets("TransferedDATA").UsedRange.Rows.Count = 1 Then
           .Range("A4:Z4").Copy Workbooks("All data.xlsm").Worksheets("TransferedDATA").Range("A4")
           StRo = .Range("AA:AA").Find("X").Row
           Lr = 4
           Else
           Lr = Workbooks("All data.xlsm").Worksheets("TransferedDATA").Range("L" & Rows.Count).End(xlUp).Row
           StRo = .Range("L:L").Find(Workbooks("All data.xlsm").Worksheets("TransferedDATA").Range("L" & Lr)).Row + 1
       End If
     
       For T = StRo To .Range("A" & Rows.Count).End(xlUp).Row
           If .Range("AA" & T) = "X" Then
               Ro2 = Ro2 + 1
               Workbooks("All data.xlsm").Worksheets("TransferedDATA").Range("A" & Lr + Ro2 & ":Z" & Lr + Ro2).Value = .Range("A" & T & ":Z" & T).Value
           End If
               
       Next T
  End With
  Application.ScreenUpdating = True
  Application.EnableEvents = True

  Workbooks("All data.xlsm").Worksheets("TransferedDATA").Activate
  Else
     Exit Sub
End If

End Sub

 

[Jirka79]

Hi Micron,

I have just send you a private message. Later on, if we solve the issue, we can paste here the new code and then close this post as "solved".

Thanks in advance for your help and support!

 

[288enzo]

Hello,

I'm a little new at this, but isn't your loop beginning at the first occurrence of X found in AA?

StRo = .Range("AA:AA").Find("X").Row

Is that by intention, or are you wanting the loop to begin at essentially the last row - 200?

 

[Jirka79]

Hello,

I'm a little new at this, but isn't your loop beginning at the first occurrence of X found in AA?

StRo = .Range("AA:AA").Find("X").Row

Is that by intention, or are you wanting the loop to begin at essentially the last row - 200?

Hi Enzo, thanks for your message!

Yes, the code is finding the "completed" rows I want to copy. Those rows have the "X" in AA.

My idea is, that if I reduce the size of the range, the loop will be faster. Note that the size of the rows can be up to 12000 rows maximum, and there is no need to loop all of them. The last 200 active rows are really enough.

 

[288enzo]

Hi Enzo, thanks for your message!

Yes, the code is finding the "completed" rows I want to copy. Those rows have the "X" in AA.

My idea is, that if I reduce the size of the range, the loop will be faster. Note that the size of the rows can be up to 12000 rows maximum, and there is no need to loop all of them. The last 200 active rows are really enough.

What about something like this for your loop?

    rowend = Cells(Rows.Count, 1).End(xlUp).Row
    rowstart = rowend - 200
    For x = rowstart To rowend

 

[Jirka79]

What about something like this for your loop?

    rowend = Cells(Rows.Count, 1).End(xlUp).Row
    rowstart = rowend - 200
    For x = rowstart To rowend

Well, you said that you are new at this... But I'm newer than you :D This means that I don't know how to edit my code in order to put these lines that you propose into it...

Could you please edit my code according to your proposal?

For a better understanding of what is doing the code:

The file named "Production data.xlsm" is were the operators introduce the parts produced. In columns A and B There are already preset the dates and time shifts until the end of the year, so there are around 4000 rows, but not all rows are and will be filled in, this is why when a row is completed with the production data required, an "X" will appear in those rows in column AA meaning that they are ready to copy to the "all data.xlsm" file. This is the first condition that the code checks. Then, the code continues and checks the the last date & time entered in column L in the file "all data.xlsm" and according to this last time, will then paste the data from "Production data.xlsm" to "All data.xlsm" starting from the point that matches the date & time until the next row containing an "X" in column AA.

So, at the end, in the file "all data.xlsm" you have all the data from "production data.xlsm" but without empty rows. So in the Excel of production data.xlsm you can have 4000 rows (with data and without data) but in the "all data.xlsm" you will have 2000 rows aprox., all of them with data

With my computer it takes up to 20 seconds when I execute the marco... so, the goal is to speed up a little bit this waiting time, because next year I will have still more data, this is why I thought that it could be a good idea to check only the last 200 values entered because I never wait too long to update the data and I think that maybe this could help to transfer the missing data much faster.

 

[288enzo]

Well, you said that you are new at this... But I'm newer than you :D This means that I don't know how to edit my code in order to put these lines that you propose into it...

Could you please edit my code according to your proposal?

For a better understanding of what is doing the code:

The file named "Production data.xlsm" is were the operators introduce the parts produced. In columns A and B There are already preset the dates and time shifts until the end of the year, so there are around 4000 rows, but not all rows are and will be filled in, this is why when a row is completed with the production data required, an "X" will appear in those rows in column AA meaning that they are ready to copy to the "all data.xlsm" file. This is the first condition that the code checks. Then, the code continues and checks the the last date & time entered in column L in the file "all data.xlsm" and according to this last time, will then paste the data from "Production data.xlsm" to "All data.xlsm" starting from the point that matches the date & time until the next row containing an "X" in column AA.

So, at the end, in the file "all data.xlsm" you have all the data from "production data.xlsm" but without empty rows. So in the Excel of production data.xlsm you can have 4000 rows (with data and without data) but in the "all data.xlsm" you will have 2000 rows aprox., all of them with data

With my computer it takes up to 20 seconds when I execute the marco... so, the goal is to speed up a little bit this waiting time, because next year I will have still more data, this is why I thought that it could be a good idea to check only the last 200 values entered because I never wait too long to update the data and I think that maybe this could help to transfer the missing data much faster.

Based on your macro, this would find the last row in column AA (rowend), then start it's loop 200 rows up (rowstart) from the last row and work it's way down.

    rowend = Cells(Rows.Count, 27).End(xlUp).Row
    rowstart = rowend - 200

    For T = rowstart To rowend

        If .Range("AA" & T) = "X" Then

            Ro2 = Ro2 + 1

            Workbooks("All data.xlsm").Worksheets("TransferedDATA").Range("A" & lr + Ro2 & ":Z" & lr + Ro2).Value = .Range("A" & T & ":Z" & T).Value

        End If

    Next T