Results 1 to 10 of 10

Thread: VBA - Filter and copy data to another tab, at bottom of existing data

  1. #1
    New Member
    Join Date
    Apr 2019
    Posts
    5
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default VBA - Filter and copy data to another tab, at bottom of existing data

    I have a four column data table that has an SQL code to refresh itself. This then needs to be filtered on column 4 (D) to value "N" (it is a vlookup against existing data in another tab, producing N when it is NOT there), and copied to the last row of the existing table. Current VBA code does not filter, but correctly only copies the first 3 columns (A to C). Please see below for code - I want the formulas and formatting to happen too, so it is really only the "filter and copy" I need:

    Code:
    Sub Update()
    
    'Does ALL of the possible AUTO work
    'Find the last used row in both sheets and copy and paste data below existing data.
    Dim wsCopy As Worksheet
    Dim wsDest As Worksheet
    Dim lCopyLastRow As Long
    Dim lDestLastRow As Long
      'Set variables for copy and destination sheets
      Set wsCopy = Worksheets("Data")
      Set wsDest = Worksheets("UPDATE_SHEET")
        
      '1. Find last used row in the copy range based on data in column A
      lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
        
      '2. Find first blank row in the destination range based on data in column A
      'Offset property moves down 1 row
      lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
      '3. Copy & Paste Data
      wsCopy.Range("A2:C" & lCopyLastRow).Copy _
        wsDest.Range("A" & lDestLastRow)
        
        
        'Check if to be reported on
        
        Dim LastRow As Long
        
        With Sheets("UPDATE_SHEET")
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            .Range("D2:D" & LastRow).Formula = _
                "=VLOOKUP($B2,List!$A:$C,2,FALSE)"
        End With
        
        'Convert DeliveryDate into an actual date
    
        
        With Sheets("UPDATE_SHEET")
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            .Range("E2:E" & LastRow).Formula = _
                "=DATEVALUE($A2)"
        End With
    
        'Lookup grouped depot name
    
        
        With Sheets("UPDATE_SHEET")
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            .Range("F2:F" & LastRow).Formula = _
                "=VLOOKUP($B2,List!$A:$C,3,FALSE)"
        End With
        'Get month for summary tab
        
        With Sheets("UPDATE_SHEET")
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            .Range("G2:G" & LastRow).Formula = _
                "=TEXT($E2,""MMM"")"
        End With
    
        'copies formatting to last row
        
        Application.ScreenUpdating = False
        
        LastRow = ActiveSheet.Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlValues, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
        LastColumn = ActiveSheet.Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlValues, _
            LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column
            
        ' Copy Format Down
        Range(Cells(3, 1), Cells(3, 9)).Copy
        Range(Cells(3, 1), Cells(3, 9)).Resize(LastRow - 2, 9). _
            PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
        
        'Selects A1
        
        Range("A1").Select
        Application.CutCopyMode = False
        
    End Sub

  2. #2
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    4,569
    Post Thanks / Like
    Mentioned
    42 Post(s)
    Tagged
    12 Thread(s)

    Default Re: VBA - Filter and copy data to another tab, at bottom of existing data

    Do you want the filter to be done after copying columns and executing the formulas?
    Regards Dante Amor

  3. #3
    New Member
    Join Date
    Apr 2019
    Posts
    5
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA - Filter and copy data to another tab, at bottom of existing data

    Hello,

    It would be filtered before copying,as I don't want the data duplicated in the second tab (it could be that the data is refreshed a few times in a day, but the SQL won't know what is already in tab2 - if that makes sense?)

  4. #4
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    4,569
    Post Thanks / Like
    Mentioned
    42 Post(s)
    Tagged
    12 Thread(s)

    Default Re: VBA - Filter and copy data to another tab, at bottom of existing data

    Try this:

    Code:
    Sub Update()
    
    
    'Does ALL of the possible AUTO work
    'Find the last used row in both sheets and copy and paste data below existing data.
    Dim wsCopy As Worksheet
    Dim wsDest As Worksheet
    Dim lCopyLastRow As Long
    Dim lDestLastRow As Long
      'Set variables for copy and destination sheets
      Set wsCopy = Worksheets("Data")
      Set wsDest = Worksheets("UPDATE_SHEET")
        
      '1. Find last used row in the copy range based on data in column A
      lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
        
      '2. Find first blank row in the destination range based on data in column A
      'Offset property moves down 1 row
      lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
      
      'filter & copy
        Dim OtherTab As Worksheet, lr2 As Long
        Set OtherTab = Sheets("Sheet2")
        wsDest.ShowAllData
        wsDest.Range("A1").AutoFilter 4, "N"
        wsDest.Range("A2:A" & lDestLastRow).EntireRow.Copy
        lr2 = OtherTab.Cells(OtherTab.Rows.Count, "A").End(xlUp).Row + 1
        OtherTab.Range("A" & lr2).PasteSpecial xlPasteValues
        wsDest.ShowAllData
      
      '3. Copy & Paste Data
      wsCopy.Range("A2:C" & lCopyLastRow).Copy _
        wsDest.Range("A" & lDestLastRow)
        
        
        'Check if to be reported on
        
        Dim LastRow As Long
        
        With Sheets("UPDATE_SHEET")
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            .Range("D2:D" & LastRow).Formula = _
                "=VLOOKUP($B2,List!$A:$C,2,FALSE)"
        End With
        
        'Convert DeliveryDate into an actual date
    
    
        
        With Sheets("UPDATE_SHEET")
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            .Range("E2:E" & LastRow).Formula = _
                "=DATEVALUE($A2)"
        End With
    
    
        'Lookup grouped depot name
    
    
        
        With Sheets("UPDATE_SHEET")
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            .Range("F2:F" & LastRow).Formula = _
                "=VLOOKUP($B2,List!$A:$C,3,FALSE)"
        End With
        'Get month for summary tab
        
        With Sheets("UPDATE_SHEET")
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            .Range("G2:G" & LastRow).Formula = _
                "=TEXT($E2,""MMM"")"
        End With
            
        'copies formatting to last row
        
        Application.ScreenUpdating = False
        
        LastRow = ActiveSheet.Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlValues, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
        LastColumn = ActiveSheet.Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlValues, _
            LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column
            
        ' Copy Format Down
        Range(Cells(3, 1), Cells(3, 9)).Copy
        Range(Cells(3, 1), Cells(3, 9)).Resize(LastRow - 2, 9). _
            PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
            
        'Selects A1
        
        Range("A1").Select
        Application.CutCopyMode = False
        
    End Sub
    Regards Dante Amor

  5. #5
    New Member
    Join Date
    Apr 2019
    Posts
    5
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA - Filter and copy data to another tab, at bottom of existing data

    THanks, I get an error on Set OtherTab = Sheets("Sheet2") - this I think defines what is already called wsDest earlier in the code which I think I need to replace (OtherTab) with here?

    Code:
    'filter & copy
        Dim OtherTab As Worksheet, lr2 As Long
        Set OtherTab = Sheets("Sheet2")
        wsDest.ShowAllData
        wsDest.Range("A1").AutoFilter 4, "N"
        wsDest.Range("A2:A" & lDestLastRow).EntireRow.Copy
        lr2 = OtherTab.Cells(OtherTab.Rows.Count, "A").End(xlUp).Row + 1
        OtherTab.Range("A" & lr2).PasteSpecial xlPasteValues
        wsDest.ShowAllData

  6. #6
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    4,569
    Post Thanks / Like
    Mentioned
    42 Post(s)
    Tagged
    12 Thread(s)

    Default Re: VBA - Filter and copy data to another tab, at bottom of existing data

    You said:

    Filter and copy data to another tab
    Then create another sheet called "Sheet2".
    What I understand is that there is data in the "UPDATE_SHEET" sheet and before copying the data from the "DATA" sheet to "UPDATE_SHEET" you first want to copy from "UPDATE_SHEET" to othersheet.
    it is right?
    If it is not correct, then you can explain the sequence of steps you require.
    Regards Dante Amor

  7. #7
    New Member
    Join Date
    Apr 2019
    Posts
    5
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA - Filter and copy data to another tab, at bottom of existing data

    I need to:
    Filter "Data" by column 4 = "N"
    Copy only column 1-3 on "Data" after filter
    Paste this onto row under last row in "Update_Sheet"

    It already does the paste where I need it (last line in below), but only copies all of the columns 1-3 of the "Data" tab

    -------

    [code]
    Sub Update()

    'Does ALL of the possible AUTO work
    'Find the last used row in both sheets and copy and paste data below existing data.
    Dim wsCopy As Worksheet
    Dim wsDest As Worksheet
    Dim lCopyLastRow As Long
    Dim lDestLastRow As Long
    'Set variables for copy and destination sheets
    Set wsCopy = Worksheets("Data")
    Set wsDest = Worksheets("UPDATE_SHEET")

    '1. Find last used row in the copy range based on data in column A
    lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row

    '2. Find first blank row in the destination range based on data in column A
    'Offset property moves down 1 row
    lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row


    '3. Copy & Paste Data
    wsCopy.Range("A2:C" & lCopyLastRow).Copy _
    wsDest.Range("A" & lDestLastRow)
    [/code

  8. #8
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    4,569
    Post Thanks / Like
    Mentioned
    42 Post(s)
    Tagged
    12 Thread(s)

    Default Re: VBA - Filter and copy data to another tab, at bottom of existing data

    Try this

    Code:
    Sub Update()
    
    
    'Does ALL of the possible AUTO work
    'Find the last used row in both sheets and copy and paste data below existing data.
    Dim wsCopy As Worksheet
    Dim wsDest As Worksheet
    Dim lCopyLastRow As Long
    Dim lDestLastRow As Long
      'Set variables for copy and destination sheets
      Set wsCopy = Worksheets("Data")
      Set wsDest = Worksheets("UPDATE_SHEET")
        
      '1. Find last used row in the copy range based on data in column A
      lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
        
      '2. Find first blank row in the destination range based on data in column A
      'Offset property moves down 1 row
      lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
      
      '3. fFilter, copy & paste data
        wsCopy.Range("A1").AutoFilter 4, "N"
        wsCopy.Range("A2:C" & lDestLastRow).Copy
        wsDest.Range("A" & lDestLastRow).PasteSpecial xlPasteValues
        wsCopy.ShowAllData
      
      '3. Copy & Paste Data
      'wsCopy.Range("A2:C" & lCopyLastRow).Copy _
        wsDest.Range("A" & lDestLastRow)
        
        
        'Check if to be reported on
        
        Dim LastRow As Long
        
        With Sheets("UPDATE_SHEET")
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            .Range("D2:D" & LastRow).Formula = _
                "=VLOOKUP($B2,List!$A:$C,2,FALSE)"
        End With
        
        'Convert DeliveryDate into an actual date
    
    
        
        With Sheets("UPDATE_SHEET")
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            .Range("E2:E" & LastRow).Formula = _
                "=DATEVALUE($A2)"
        End With
    
    
        'Lookup grouped depot name
    
    
        
        With Sheets("UPDATE_SHEET")
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            .Range("F2:F" & LastRow).Formula = _
                "=VLOOKUP($B2,List!$A:$C,3,FALSE)"
        End With
        'Get month for summary tab
        
        With Sheets("UPDATE_SHEET")
            LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            .Range("G2:G" & LastRow).Formula = _
                "=TEXT($E2,""MMM"")"
        End With
            
        'copies formatting to last row
        
        Application.ScreenUpdating = False
        
        LastRow = ActiveSheet.Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlValues, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
        LastColumn = ActiveSheet.Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlValues, _
            LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column
            
        ' Copy Format Down
        Range(Cells(3, 1), Cells(3, 9)).Copy
        Range(Cells(3, 1), Cells(3, 9)).Resize(LastRow - 2, 9). _
            PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
            
        'Selects A1
        
        Range("A1").Select
        Application.CutCopyMode = False
        
    End Sub
    Regards Dante Amor

  9. #9
    New Member
    Join Date
    Apr 2019
    Posts
    5
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: VBA - Filter and copy data to another tab, at bottom of existing data

    @Dante Amor:
    Thank you so much for your help! The ShowAllData section errors, but I have removed that as the original data is longer required for anything once it is copied into the new tab.
    Thank you again!

  10. #10
    Board Regular DanteAmor's Avatar
    Join Date
    Dec 2018
    Location
    México
    Posts
    4,569
    Post Thanks / Like
    Mentioned
    42 Post(s)
    Tagged
    12 Thread(s)

    Default Re: VBA - Filter and copy data to another tab, at bottom of existing data

    I'm glad to help you. Thanks for the feedback.
    Regards Dante Amor

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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