PDA

View Full Version : Transfer specific columns from sheet to another



joky
01-30-2023, 09:29 AM
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
01-30-2023, 01:55 PM
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
01-30-2023, 03:17 PM
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
01-30-2023, 11:52 PM
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
01-31-2023, 04:11 AM
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
01-31-2023, 04:15 AM
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
01-31-2023, 04:34 AM
Will check and revert back...Thanks again.

joky
01-31-2023, 05:25 AM
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
01-31-2023, 06:20 AM
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
01-31-2023, 07:10 AM
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
01-31-2023, 07:22 AM
Attached is the file i was playing with.

joky
01-31-2023, 07:33 AM
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
01-31-2023, 11:28 AM
How can this be done using arrays?