How do I change the range in this code.

[RAJESH1960]

'for' Loop @Fluff need your help to edit this..
This code was shared by Fluff last year which worked correctly in the previous project. At first the data extracted was filled in around 600 rows but when the value of the amount to be extracted has increased, it is not possible to get the data in 600 rows. Hence the formulas in rows after the 600th row have been shifted to the top so that I can get unlimited rows to fill the data.
If the number of rows is avoided and changed to unlimited rows it will be really helpful in future.
I am trying this code by changing the range in the code by editing it. But I am getting a run time error 1004 at this line. Can someone please help me to correct it.? I want to add this code at the end of the existing code.

         Cells(2000, .Offset(, -14).Column).End(xlUp).Offset(1).Resize(2).Value = .Offset(.Count - 2).Resize(2).Value

Link to the file is below
Shift amounts.xlsm

 

[johnnyL]

Just make sure you are timing it correctly by placing the code at the proper spots You don't want to mislead yourself with improper timing.

 

[RAJESH1960]

I used it temporarily just to check. I don't use that in any application. Even the speak application which worked in my system only I saved it for my entertainment. It doesn't work in office system due to different configuration and maybe mute button is activated. It used to generate an error.

 

[johnnyL]

Well if you haven't modified the script since previously mentioned, the code would look like:

Option Explicit

Sub ClearOldData()
'
    Dim StartTime                   As Double
    StartTime = Timer
'
    Sheets("Extract").Range("A7", Sheets("Extract").Range("A7").SpecialCells(xlLastCell)).ClearContents         ' Clear Old data from 'Extract' sheet
    Application.Goto Sheets("Extract").Range("A7")
'
    Sheets("Daily").Range("A2:D2", Sheets("Daily").Range("A2:D2").End(xlDown)).ClearContents                    ' Clear Old data from 'Daily' sheet
    Application.Goto Sheets("Daily").Range("A2")
'
''    Sheets("CR").Range("A2:E2", Sheets("CR").Range("A2:E2").End(xlDown)).ClearContents                          ' Clear Old data from 'CR' sheet
''    Application.Goto Sheets("CR").Range("A2")
'
    Sheets("Total").Range("A2:E2", Sheets("Total").Range("A2:E2").End(xlDown)).ClearContents                    ' Clear Old data from 'Total' sheet
    Application.Goto Sheets("Total").Range("A2")
'
    Call AExtract.Extract                                                                                       ' Run the subroutine 'Extract' in the 'AExtract' module
    Call BShiftAmounts.ShiftAmounts                                                                             ' Run the subroutine 'ShiftAmounts' in the 'BShiftAmounts' module
    Call CCopy_To_Daily.Copy_To_Daily                                                                           ' Run the subroutine 'Copy_To_Daily' in the 'CCopy_To_Daily' module
    Call Get_Total.Get_Total                                                                                    ' Run the subroutine 'Get_Total' in the 'Get_Total' module
'
    Debug.Print "Time to complete = " & Timer - StartTime & " seconds."
End Sub