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

 

[RAJESH1960]

When you are including the clear old data code in Extract code, don't include the CR sheet. That has to be manually replaced.

 

[johnnyL]

Here is the code to all run from the 'Clear Old Data' button:

Option Explicit

Sub ClearOldData()
'
    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
End Sub

 

[RAJESH1960]

When I tried to use the call button I didn't add the module name but the sub name.

 

[johnnyL]

When I tried to use the call button I didn't add the module name but the sub name.

Whatever you do, don't read post #35.

 

[RAJESH1960]

Whatever you do, don't read post #35.

I read it but in the excitement I didn't notice the A B and C before the code name At least today I learnt something new. Call is for module name not code name.

 

[RAJESH1960]

Time to hit the sack. See you in the morning. Good night

 

[johnnyL]

I think you are confused a bit. The A, B, C has nothing to do with this. That just happens to be what the module names started with.
Example ... You have a module named 'Get_Total' & the subroutine that you want to call in that module is also named 'Get_Total' therefor you would use"
Call Get_Total.Get_Total

If you had a module named 'Flavors' and a subroutine inside of that module was named 'Cherry', You would use:
Call Flavors.Cherry

 

[RAJESH1960]

I think you are confused a bit. The A, B, C has nothing to do with this. That just happens to be what the module names started with.
Example ... You have a module named 'Get_Total' & the subroutine that you want to call in that module is also named 'Get_Total' therefor you would use"
Call Get_Total.Get_Total

If you had a module named 'Flavors' and a subroutine inside of that module was named 'Cherry', You would use:
Call Flavors.Cherry

Ahaa. Now I understood. I wrote Call Extract whereas I had to write Call AExtract.Extract .

 

[johnnyL]

Yep.

Here is the reworked 'Get_Total' subroutine:

Option Explicit

Sub Get_Total()

Dim drng As Range, crng As Range, dr As Long, cr As Long
'
    Application.ScreenUpdating = False
    Application.EnableEvents = False
'
    With Sheets("Daily")
        Set drng = .Range("A2:C" & .Cells(.Rows.Count, 1).End(3).Row)
        dr = drng.Rows.Count
''        drng.Columns(2) = "Cash"
        End With
'
    With Sheets("CR")
        Set crng = .Range("A2:D" & .Cells(.Rows.Count, 1).End(3).Row)
        cr = crng.Rows.Count
    End With
'
    With Sheets("Total")
        .Cells(Rows.Count, 1).End(3).Offset(1).Resize(dr) = drng.Columns(1).Value
        .Cells(Rows.Count, 3).End(3).Offset(1).Resize(dr) = drng.Columns(2).Value
        .Cells(Rows.Count, 4).End(3).Offset(1).Resize(dr) = drng.Columns(3).Value
        .Cells(Rows.Count, 5).End(3).Offset(1).Resize(dr) = drng.Columns(4).Value
'
        If Sheets("CR").Range("A2") <> vbNullString Then
            .Cells(Rows.Count, 1).End(3).Offset(1).Resize(cr, 4) = crng.Value
        End If
'
        .Sort.SortFields.Clear
        .Range("A2:E" & .Range("A" & Rows.Count).End(xlUp).Row).Sort _
                Key1:=.Range("D2"), Order1:=xlAscending, Header:=xlNo
    End With
'
    Application.Goto Sheets("Total").Range("D2")
'
    Application.EnableEvents = True
    Application.ScreenUpdating = True
'
MsgBox "Data extracted successfully."
End Sub

 

[johnnyL]

Let us know if there is anything left to address.