PDA

View Full Version : Transferring data from a table on one sheet to another and appending the existing dat



mongoose
03-11-2020, 12:53 PM
I have an excel file which is running too slow because of the amount of data in it. I have a table named "Table3" in Sheet1 and I would like to move the data into an identical table in Sheet4.
But I need to only pull data that fall into a certain date range. If the date in Column "Actual Ship Date" doesn't fall within the range of today's date + 14 days; then it gets moved to the table on Sheet4.
Basically the table in Sheet4 would be a sort of archive. When the data gets moved, I need it to add to any data that is already there and not overwrite the data which is there.
Can anyone help point me in the right direction? I'd rather not loop through cell after cell unless I have to. I have heard and experienced how slow it is but am unfamiliar of another route?

mongoose
03-11-2020, 01:42 PM
Here is my code so far but I am getting an error: "Expected End of Statement" on the line with the .AutoFilter...


Sub ArchiveData()
'Instansiate Objects & Setup Vars
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Dim filteredData As Range
Dim lastRow As Long

'Set Objects
Set copySheet = Me.Worksheets("Prod. Data")
Set pasteSheet = Me.Worksheets("Archive")
Set filteredData = copySheet.ListObjects("Table3").Range.AutoFilter Field:=16, Criteria1:= ">=2/1/2020", Operator:=xlAnd, Criteria2:="<=2/15/2020"

'Copy the data
copySheet.Range("Table3").Copy Destination:=pasteSheet.Range("Table4")
End Sub

p45cal
03-18-2020, 03:56 PM
try:
Sub blah()
Dim cellstomove As Range

Set pasteSheet = Me.Worksheets("Archive")
Set copySheet = Me.Worksheets("Prod. Data")
Set yyy = copySheet.ListObjects("Table3")
yyy.Range.AutoFilter Field:=16, Criteria1:=">" & CLng(Date + 14), Operator:=xlOr, Criteria2:="<" & CLng(Date)
On Error Resume Next
Set cellstomove = yyy.DataBodyRange.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If cellstomove Is Nothing Then
MsgBox "no rows to move"
Else
cellstomove.Copy pasteSheet.ListObjects("Table4").ListRows.Add.Range
yyy.Range.AutoFilter Field:=16
cellstomove.Delete
End If
End SubNote that this does what you asked for: "If the date in Column "Actual Ship Date" doesn't fall within the range of today's date + 14 days; then it gets moved to the table on Sheet4." which means data with dates more than two weeks in the future also get moved to the Archive sheet.