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!

 

[Jirka79]

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

Hi Enzo,

I have used your the part of your code replacing mine and works pretty fast, but doesn't take into account the last value entered in column "L". Therefore I can't use your code.... :/

Maybe I'm wrong, but I think your code needs to mention StRo

           StRo = .Range("L:L").Find(Workbooks("All data.xlsm").Worksheets("TransferedDATA").Range("L" & Lr)).Row + 1

What do you think?

 

[Micron]

There was something that looked like an add-in in those zip files. If I need the add in I'll just see what I can do without it. There are about 5 dll files amongst those sub folders.