Consulting

Results 1 to 3 of 3

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

  1. #1
    VBAX Regular
    Joined
    Jul 2019
    Posts
    51
    Location

    Transferring data from a table on one sheet to another and appending the existing dat

    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?

  2. #2
    VBAX Regular
    Joined
    Jul 2019
    Posts
    51
    Location
    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

  3. #3
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,874
    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 Sub
    Note 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.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •