Transfer specific columns from sheet to another

[joky]

Hello everyone, It would be appreciated if someone could kindly assist me
I'm trying create a macro that upon running, will look at the dates in column "P" and if this dates is before older than from the current month,Transfer the Columns(A:F) & Columns("O:T") to archives sheet for reference when needed..Then delete of rows that were Transfered from the main sheet How this can be done? The data starts at row 8 to the last row used and headers at row 7
Any help in the correct direction is appreciated!!! - thanks in advance....

[June7]

Instead of 'moving' records, could just set value of cell that changes record status then apply filter to not display those 'archived' records. Why use Excel as a database?

[joky]

Thanks a lot for your reply
The main sheet will be updated once a month and at the same time, I want to keep some data in the archive sheet for yearly payments,Thanks again.

[georgiboy]

Maybe something like the below:

Sub test()
    Dim rng As Range
    
    Set rng = [A7].CurrentRegion
    
    If Not ActiveSheet.AutoFilterMode = True Then [A7].AutoFilter
    [A7].AutoFilter 16, "<" & DateSerial(Year(Now()), Month(Now()), 1)
    On Error GoTo NoCells
    Union(Range(rng(2, 1), rng(rng.Rows.Count, 6)), Range(rng(2, 15), rng(rng.Rows.Count, 20))).SpecialCells(xlCellTypeVisible).Copy
    On Error GoTo 0
    Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    Application.DisplayAlerts = False
    rng.Offset(1).Resize(rng.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Delete
    Application.DisplayAlerts = True
    [A7].AutoFilter
    Application.CutCopyMode = False
    Exit Sub
    
NoCells:
    MsgBox "No older dates found"
End Sub

[joky]

many thanks for your effort!
I tried to run this and I get a run-time error in this line

    [A7].AutoFilter 16, "<" & DateSerial(Year(Now()), Month(Now()), 1)

how can fix that? Thanks again.

[georgiboy]

Maybe the layout of the file you are trying to put the code in is different from the original example file submitted. Attached is the code running in the example file.

[joky]

Will check and revert back...Thanks again.

[joky]

This is great when working with low row numbers, however I'm now working on a file with 15000 rows and the macro is taking very long to process
I need to rely on VBA arrays as possible as I can as original data is very large.
Can it be possible? if that makes sense.
thank you for your assistance and cooperation

[georgiboy]

I don't think arrays will save that much here, the time is being taken deleting the rows from the sheet 'Main'

If you manually add your filter and then delete the rows that are left manually you will see what i mean.

You could have another tab for this month and move the data that is needed to that, thus removing the need to delete:

Sub test()
    Dim rng As Range
    
    Set rng = [A7].CurrentRegion
    
    If Not ActiveSheet.AutoFilterMode = True Then [A7].AutoFilter
    [A7].AutoFilter 16, "<" & DateSerial(Year(Now()), Month(Now()), 1)
    On Error GoTo NoCells
    Union(Range(rng(2, 1), rng(rng.Rows.Count, 6)), Range(rng(2, 15), rng(rng.Rows.Count, 20))).SpecialCells(xlCellTypeVisible).Copy
    On Error GoTo 0
    Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    
    [A7].AutoFilter 16, ">=" & DateSerial(Year(Now()), Month(Now()), 1)
    On Error GoTo NoCells
    rng.Offset(1).Resize(rng.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy
    On Error GoTo 0
    Sheet3.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    [A7].AutoFilter
    Exit Sub
    
NoCells:
    MsgBox "No older/ newer dates found"
End Sub

Other than that maybe someone else here on the forum has a suggestion?

[joky]

for a reason I don't understand, same previous error message

    [A7].AutoFilter 16, "<" & DateSerial(Year(Now()), Month(Now()), 1)

I think it would be worthwhile using arrays if there's lots of data but I cannot find how to do this .... You can send an attachment.. Thanks again.

[georgiboy]

Attached is the file i was playing with.

[joky]

Thanks a lot for great help you offered in this issue, I respect for your kind time and help
Have a nice time my Professor .... Best Regards

[joky]

How can this be done using arrays?