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

AndyRaab

New Member
Joined
Apr 19, 2019
Messages
5
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
 

Some videos you may like

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
11,678
Office Version
2007
Platform
Windows
Do you want the filter to be done after copying columns and executing the formulas?
 

AndyRaab

New Member
Joined
Apr 19, 2019
Messages
5
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?)
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
11,678
Office Version
2007
Platform
Windows
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
  
[COLOR=#0000ff]  'filter & copy[/COLOR]
[COLOR=#0000ff]    Dim OtherTab As Worksheet, lr2 As Long[/COLOR]
[COLOR=#0000ff]    Set OtherTab = Sheets("Sheet2")[/COLOR]
[COLOR=#0000ff]    wsDest.ShowAllData[/COLOR]
[COLOR=#0000ff]    wsDest.Range("A1").AutoFilter 4, "N"[/COLOR]
[COLOR=#0000ff]    wsDest.Range("A2:A" & lDestLastRow).EntireRow.Copy[/COLOR]
[COLOR=#0000ff]    lr2 = OtherTab.Cells(OtherTab.Rows.Count, "A").End(xlUp).Row + 1[/COLOR]
[COLOR=#0000ff]    OtherTab.Range("A" & lr2).PasteSpecial xlPasteValues[/COLOR]
[COLOR=#0000ff]    wsDest.ShowAllData[/COLOR]
  
  '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
 

AndyRaab

New Member
Joined
Apr 19, 2019
Messages
5
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
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
11,678
Office Version
2007
Platform
Windows
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.
 

AndyRaab

New Member
Joined
Apr 19, 2019
Messages
5
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
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
11,678
Office Version
2007
Platform
Windows
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
  
[COLOR=#0000ff]  '3. fFilter, copy & paste data[/COLOR]
[COLOR=#0000ff]    wsCopy.Range("A1").AutoFilter 4, "N"[/COLOR]
[COLOR=#0000ff]    wsCopy.Range("A2:C" & lDestLastRow).Copy[/COLOR]
[COLOR=#0000ff]    wsDest.Range("A" & lDestLastRow).PasteSpecial xlPasteValues[/COLOR]
[COLOR=#0000ff]    wsCopy.ShowAllData[/COLOR]
  
  '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
 

AndyRaab

New Member
Joined
Apr 19, 2019
Messages
5
@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!
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
11,678
Office Version
2007
Platform
Windows
I'm glad to help you. Thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,098,871
Messages
5,465,192
Members
406,416
Latest member
Revolution_72

This Week's Hot Topics

Top