VBA Code to Copy / Paste efficiently and re-apply

[Kemidan2014]

I posted in an earlier thread and found some answers however I still lack some finishing touches to the code to complete the task i would like to do.
Macro I would like to achieve is this
Copy Rows based on matching Criteria (so far i have that working)
Paste rows as values in another sheet (also seems to work)
Stops looking to copy and paste when it gets to the bottom rows of data on Sheet 1 that are Vlookups with no value (#N/A) (this is where i struggle)

I would like the pasting on the new sheet to always start in a specific row so that the headers aren't copied over
I would like when i rerun the macro for the previous pasted data to be cleared and then new updated data inserted.

Below is sample of my code that I crowdsourced from google. Ideally I wanted to Tie this macro to a shape button so over time as we click it it will reupdate "Sheet2"

Thank you readers for your time!

Sub Filter_Data()
lastrow = Worksheets("sheet1").Range("A" & Rows.count).End(xlUp).Row

For r = 6 To lastrow
 If Not Error("Sheet1").Cells("G") Then
    If Worksheets("Sheet1").Range("D" & r).Value = "0101-6" And Worksheets("Sheet1").Range("G" & r).Value <> "Closed-Cancelled" And Worksheets("Sheet1").Range("G" & r).Value <> "Closed - LTCM Effective" And Worksheets("Sheet1").Range("G" & r).Value <> "Closed - LTCM Ineffective" And Worksheets("Sheet1").Range("G" & r).Value <> "Closed-No Response Required" And Worksheets("Sheet1").Range("G" & r).Value <> "#N/A" Then
      Worksheets("Sheet1").Rows(r).Copy
      Worksheets("Sheet2").Activate
      lastrowaact = Worksheets("Sheet2").Range("A" & Rows.count).End(xlUp).Row
      Worksheets("Sheet2").Range("A" & lastrowaact + 1).PasteSpecial Paste:=xlPasteValues
        
    End If
 End If
 
End Sub

 

[mumps]

It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of Sheet1. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

 

[Kemidan2014]

Thank you for the advice. Let me make a mock sample set of sheet one in a separate copy of the xlsm. we have alot of information thats proprietary but i will pare it down the information into a sampling of data and attach it using XL2BB

 

[mumps]

Please attach a screenshot not a picture.

 

[Kemidan2014]

Okay i hope this works I am attaching "Sheet 1"

Customer Database Test for mrxcel.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V
5	QIMS#	Doc Type	Rank	Supplier Code	Part Name	Part Number	Overall Status	NCD Description	Model	LT CM Plan Due	Original LTCM Actual Due Date	Revised LTCM Actual Due Date	Close	Initial Issuance Date	Official Issuance Date	LTCM Plan Submitted	LTCM Plan Accepted Date	LTCM Plan Rejection Date	LTCM Actual Submitted	LTCM Actual Accepted Date	LTCMActualRejectionDate	NAMC
6	01-01016-V6-4053	QPR	B	0101-6	Part 1	11122-33444	Closed-Cancelled	FIT CONDITION	V6				5/3/21	4/28/21								Cust 1
7	01-01016-V6-4054	QPR	B	0101-6	Part 1	11122-33444	Closed-Cancelled	LOOSE	V6				5/3/21	4/28/21								Cust 1
8	01-01016-V6-4055	QPR	C	0101-6	Part 1	11122-33444	Closed-Cancelled	POPPING / PULLING OUT	V6				5/3/21	4/28/21								Cust 1
9	01-01016-V6-4086	QPR	B	0101-6	Part 2	11122-33444	Closed-Cancelled	WRONG PART	V6				3/8/22	3/7/22								Cust 1
10	14-01016-ZR-4093	QPR	B	0101-6	Part 3	22233-44555	Awaiting Official, STCM Approved	FOREIGN MATERIAL	I4					3/31/22								Cust 2
11	14-01016-ZR-4094	QPR	B	0101-6	Part 3	22233-44555	Awaiting Official, STCM Approved	CRACKED	I4					4/1/22								Cust 2
12	15-01022-M20-4009	QPR	B	0102-2	Part 4	11122-33444	Awaiting Official, STCM Approved	LEAKS	I4					3/31/22								Cust 3
13	01-01016-T1-4027	QPR	B	0101-6	Part 60	11122-33444	Officially Released, Awaiting LTCM Plan	ABNORMAL NOISE	V6	4/19/22				4/1/22	4/4/22							Cust 1
14	15-01022-M20-4008	QPR	B	0102-2	part 4	11122-33444	Officially Released, Awaiting LTCM Plan	Other	I4	4/17/22				3/31/22	4/2/22							Cust 3
15	14-01017-TNGA-4016	QIR	C	0101-7	Part 1	22233-44555	Officially Released, Awaiting LTCM Plan	FOREIGN MATERIAL	I4	4/14/22				3/29/22	3/30/22							Cust 2
16	14-01016-TNGA-4098	QPR	B	0101-6	Part 5	22233-44555	Officially Released, Awaiting LTCM Plan	EXCESS MATERIAL	I4	4/12/22				3/23/22	3/28/22							Cust 2
17	01-01016-V6-4090	QIR	B	0101-6	Part 2	22233-44555	LTCM Plan Accepted, Awaiting LTCM Actual	ADHESIVE NG	V6	4/7/22	4/15/22			3/22/22	3/23/22	3/31/22	4/4/22					Cust 1
18	01-01022-T2-4019	QPR	C	0102-2	Part 1	22233-44555	LTCM Plan Accepted, Awaiting LTCM Actual	APPEARANCE DEFECT	I4	4/1/22	4/8/22			3/15/22	3/17/22	3/31/22	4/4/22					Cust 1
19	14-01016-GR-4192	QPR	B	0101-6	Part 2	22233-44555	LTCM Plan Accepted, Awaiting LTCM Actual	MISSING PART	V6	4/1/22	4/15/22			3/16/22	3/17/22	3/31/22	4/1/22					Cust 2
20	01-01016-V6-4089	QIR	B	0101-6	Part 2	22233-44555	LTCM Plan Accepted, Awaiting LTCM Actual	NOT SEATED	V6	3/29/22	4/1/22			3/11/22	3/14/22	3/30/22	3/31/22					Cust 1
21	15-01016-V6T-4002	QIR	C	0101-6	part 70	22233-44555	Awaiting LTCM Plan Response Acceptance, LTCM Plan Submitted	BURRS	V6T	3/23/22	5/31/22			2/11/22	3/8/22	3/23/22						Cust 3
22	14-01016-T24-4001	QIR	B	0101-6	Part 2	22233-44555	Closed - LTCM Effective	MISSING SUB-COMPONENT	I4	3/8/22	2/22/22		2/28/22	2/20/22	2/21/22				2/22/22			Cust 2
23	14-01016-GR-4187	QPR	C	0101-6	Part 2	22233-44555	Closed - LTCM Effective	NOT SEATED	V6	2/26/22	3/11/22		4/3/22	2/10/22	2/11/22	2/25/22	3/2/22		3/30/22			Cust 2
24	15-01016-A25-4027	QPR	C	0101-6	Part 2	22233-44555	LTCM Plan Accepted, Awaiting LTCM Actual	MACHINING DEFECT	I4	2/23/22	3/31/22			1/5/22	2/8/22	2/23/22	2/25/22					Cust 3
25	14-01017-TNGA-4015	QPR	B	0101-7	Part 8	22233-44555	Closed - LTCM Effective	BROKEN / BREAKING	I4	2/22/22	2/25/22		3/13/22	2/7/22	2/7/22	2/21/22	2/22/22		3/8/22			Cust 2
26	14-01016-TNGA-4095	QPR	B	0101-6	Part 9	22233-44555	LTCM Plan Accepted, Awaiting LTCM Actual	MACHINING DEFECT	I4	2/16/22	2/28/22			1/27/22	2/1/22	2/15/22	2/17/22					Cust 2
27	15-01016-2GR-4111	QPR	C	0101-6	Part 10	22233-44555	LTCM Actual Accepted, Awaiting LTCM Confirmation	NOT TAPPED	V6	2/11/22	3/7/22			1/20/22	1/27/22	2/10/22	3/2/22		3/23/22			Cust 3
28	14-01022-TNGA-4037	QPR	C	0102-2	Part 1	22233-44555	Closed - LTCM Effective	FLASH	I4	1/29/22	2/11/22		2/15/22	1/13/22	1/14/22	2/8/22	2/9/22		2/9/22			Cust 2
29	15-01016-M20-4015	QPR	B	0101-6	Part 3	22233-44555	LTCM Plan Accepted, Awaiting LTCM Actual	Other	I4	1/29/22	2/25/22			1/13/22	1/14/22	2/7/22	2/15/22					Cust 3
30	44-01016-SRVC-4017	QIR	B	0101-6	Part 5	22233-44555	Closed-No Response Required	Dealer Claim	V6	1/21/22			1/21/22	1/6/22	1/6/22							Cust 4
31	15-01016-M20-4014	QPR	C	0101-6	Part 8	22233-44555	LTCM Plan Accepted, Awaiting LTCM Actual	Other	I4	1/6/22	2/25/22			12/21/21	12/22/21	2/7/22	2/8/22					Cust 3
Sheet1

 

[Kemidan2014]

in my haste to show a sampling of data i wanted to copy over to another sheet i eliminated the cells below that are formulas which are referencing blank cells in a master file that show up as "#N/A" because the result is blank.

Trying to figure out how to ignore such errors

 

[mumps]

Make sure that you have headers in row 1 of Sheet2 and then try this macro:

Sub Filter_Data()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Sheet2")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    desWS.UsedRange.Offset(1).ClearContents
    With srcWS
        .Range("W2:W" & LastRow).Formula = "=IF(AND(D2=""0101-6"",G2<>""Closed-Cancelled"",G2<>""Closed - LTCM Effective"",G2<>""Closed - LTCM Ineffective"",G2<>""Closed-No Response Required"",G2<>""#N/A""),""true"",""false"")"
        .Cells(1).CurrentRegion.AutoFilter 23, "true"
        .Range("A2:V" & LastRow).SpecialCells(xlCellTypeVisible).Copy
        With desWS
            .Cells(.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues
            .Columns.AutoFit
        End With
        .Range("A1").AutoFilter
        .Columns("W").Delete
    End With
    Application.ScreenUpdating = True
End Sub

The macro use a helper column (column W) so I assume that column W will not be used.

 

[Kemidan2014]

Gave it a test recieved Run time Error 1004 Autofilter method of Range class failed. Debug highlighted

.Cells(1).CurrentRegion.Autofilter 23, "True"

 

[mumps]

I tested the macro on the data you posted and it worked properly. Are you using the macro on data that is different from the data you posted?

 

[Kemidan2014]

AH! i forgot to shift the columns so the header was on Row 1. i did that and it worked! Thank you. however i was hoping to reserve space above my for buttons but i guess i could just widen Row 1 itself to make white space =)