Copy and paste from sheet to sheet based on matching criteria

[Kemidan2014]

I am trying to expand my complaint tracking sheet that we use to monitor and track status of complaints over time. I am OK with copy paste macros but i still cant wrap my mind around looking up and matching to paste data.

here is summary of what the sheet does from logic stand point

On open it references a master file that we download from customer website weekly and updates Sheet 1, this is done with macros.
Sheet 2 uses macro to clear contents of sheet 2, filter sheet 1 based on criteria and copy paste data from sheet 1 into sheet 2.
What we want to add new macro to append the data in sheet 1 FROM sheet 2 this time by adding columns of data on the side outside of what we get from customer and paste that information into the corresponding record into Sheet 1. right now we do this manually and its a pain because the records on sheet 1 is over 1000 but sheet 2 based on criteria usually has 20 so its easier to find and update on sheet 20 and throw it back to sheet 1

here is sheet 2

Customer Complaint Tracker.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z
1	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	AACT QE	AM	NEXT STEPS	TARGET
2	14-01016-ZR-4093	QIR	B	0101-6	COVER ASSY, TIMING CHAIN W/WATER PUMP	11310-0T180	Officially Released, Awaiting LTCM Plan	FOREIGN MATERIAL	ZR	4/19/22				3/31/22	4/4/22							TMMWV	Blake Lafferty	Chris	<insert activity here>	"date"
3	14-01016-ZR-4094	QPR	B	0101-6	COVER ASSY, TIMING CHAIN W/WATER PUMP	11310-0T180	Officially Released, Awaiting LTCM Plan	CRACKED	ZR	4/19/22				4/1/22	4/4/22							TMMWV	Blake Lafferty	Chris
4	01-01016-T1-4027	QPR	B	0101-6	PUMP ASSY, OIL	15100-F0011	Officially Released, Awaiting LTCM Plan	ABNORMAL NOISE	T1	4/19/22				4/1/22	4/4/22							TMMK-PWT	Misty Gatliff	Mike
5	14-01016-TNGA-4098	QPR	B	0101-6	PISTON	13211-F0010	Awaiting LTCM Plan Response Acceptance, LTCM Plan Submitted	EXCESS MATERIAL	TNGA	4/12/22	4/22/22			3/23/22	3/28/22	4/14/22						TMMWV	Ace Staton	Chris
AACT

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
A2:V50	Expression	=ISBLANK($A2)	text	NO
A2:V50	Expression	=AND($J2<=TODAY(),$J2>=(TODAY()-5))	text	NO
A2:V50	Expression	=NOT(ISBLANK($M2))	text	NO
A2:V50	Expression	=$J2<=TODAY()	text	NO

Where column W X Y and Z is the data we want to copy using matching Complaint number in Column A

Here is sheet 1 destination

Customer Complaint Tracker.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z
1	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	AACT QE	AM	NEXT STEPS	TARGET
2	01-01016-V6-4053	QPR	B	0101-6	COVER SUB-ASSY, CYLINDER HEAD, LH	11202-0P011	Closed-Cancelled	FIT CONDITION	V6				5/3/2021	4/28/2021								TMMK-PWT
3	01-01016-V6-4054	QPR	B	0101-6	COVER SUB-ASSY, CYLINDER HEAD, RH	11201-0P010	Closed-Cancelled	LOOSE	V6				5/3/2021	4/28/2021								TMMK-PWT
4	01-01016-V6-4055	QPR	C	0101-6	COVER SUB-ASSY, CYLINDER HEAD, LH	11202-0P040	Closed-Cancelled	POPPING / PULLING OUT	V6				5/3/2021	4/28/2021								TMMK-PWT
5	01-01016-V6-4086	QPR	B	0101-6	COVER ASSY, TIMING CHAIN	11310-0P050	Closed-Cancelled	WRONG PART	V6				3/8/2022	3/7/2022								TMMK-PWT
6	0101-6-080-4004	QPR	B	0101-6	COVER ASSY, TIMING CHAIN	11310-0V020	Closed-Cancelled	SCRATCHES	080Y,417W,434W,502W,511W,512W,537W,541W,567W,574W,				9/25/2017	9/15/2016								TMMAL
7	0101-6-116-4005	QPR	B	0101-6	COVER SUB-ASSY, CYLINDER HEAD, RH	11201-0P010	Closed - LTCM Effective	MISSING PART	116Y,118Y,614W,641W,663W,672W,676W,699W,705W,709W	2/22/2017	3/10/2017		9/23/2017	1/30/2017	2/7/2017	2/28/2017			4/6/2017	4/18/2017		TMMWV
Complaints

Cells with Data Validation
Cell	Allow	Criteria
W2:W1048576	List	=Lists!$A$2:$A$14
X2:X1048576	List	=Lists!$C$2:$C$12
Y2:Y1048576	List	=Lists!$F$2:$F$11

again destination columns are W X Y Z but as you can see the complaint numbers in Sheet 1 are in a different order becuase we use filtering in Sheet 2 for easy tracking because once complaint is closed its just there for reference.

In the example the expectation is when i engage macro the information that we manually added Sheet 2 W2, X2, Y2, and Z2 will be copy and pasted into Sheet 1 W77, X77, Y77, and Z77 because thats where the record is in Sheet 1. this information can overwritten because for example the owner ship may change, the next step may change and the date may change we just dont want to alter data in any other columns.

i appreciate your knowledge!

 

[Kemidan2014]

Okay replace Sheet 2 with AACT and Sheet 1 with Complaints hah i didnt realize minisheets gave you this much detail

 

[Kemidan2014]

This is code i have Cannibalized from else where in my workbook I feel like starting at "For Each c...." needs to change alot because this is basically trying to add new information and add it to the bottom, i test it but it doesnt error but it also doesnt do anything either...

Private Sub Testcopy()
  Dim srcSH As Worksheet, desSH As Worksheet
  Dim i As Long, j As Long, nRow As Long, n As Long
  Dim rng As Range, col As Range, c As Range, f As Range
 
  Application.ScreenUpdating = False
  Sheets("Complaints").Unprotect Password:="Secret"
  Set srcSH = Workbooks("Customer Complaint Tracker test.xlsm").Sheets("AACT")
  Set desSH = Workbooks("Customer Complaint Tracker test.xlsm").Sheets("Complaints")
  Set rng = srcSH.Range("W:Z")
 
  For Each c In srcSH.Range("A2", srcSH.Range("A" & Rows.count).End(3))
    Set f = desSH.Range("A:A").Find(c.Value, , xlValues, xlWhole, , , False)
    If Not f Is Nothing Then nRow = f.Row Else nRow = desSH.Range("A" & Rows.count).End(3).Row + 1
    j = 0
    For Each col In rng.Columns
      n = col.Column
      j = j + 1
      desSH.Cells(nRow, j).Value = srcSH.Cells(c.Row, n).Value
    Next
  Next
  Sheets("Complaints").Protect Password:="Secret"
  Application.ScreenUpdating = True
End Sub

 

[Kemidan2014]

So someone showed me the magic of Record Macro button in developer tab which OMG im going to use this from now on however to answer my own question for the benefit of the forum I have attached the result that works.

Sub Testfilter ()
'Make declarations
  Dim lookupsheet As Worksheet, updatesheet As Worksheet
  Dim valuetosearch As String
  Dim i As Integer, t As Integer
'Disable screen update and unprotect Complaints
  Application.ScreenUpdating = False
  Sheets("Complaints").Unprotect Password:="Secret"
 'Define a couple of the declarations
 Set lookupsheet = Worksheets("AACT")
 Set updatesheet = Worksheets("Complaints")
 
 'Look for last rows in both sheets
 lastrowlookup = lookupsheet.Range("A1").End(xlDown).Row
 lastrowupdate = updatesheet.Cells(Rows.Count, "A").End(xlUp).Row
 'Select last row in look up sheet
 Cells(lastrowlookup, 1).Select
 Dim searchrange As Range
 Set searchrange = Range(Cells(2, 1), Cells(lastrowlookup, 1))
 

'''''
'check for macro

  Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Range("A2").Select
ActiveCell.FormulaR1C1 = "=IF(COUNTIF(C[1],RC[1])>1,""Error"",""OK"")"
    Selection.AutoFill Destination:=Range("A2:A29")
    Range("A2:A29").Select
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(R[1]C:R[28]C,""Error"")"
    Range("A2").Select


If Range("A1").Value > 0 Then
    MsgBox ("You messed up")
    Else
    Columns("A:a").Delete
    End If

'filter for complaint
 updatesheet.Select
 Rows("1:1").Select
 Selection.AutoFilter
 lookupsheet.Select
Range("a1").Select
 counter = 0
 
 

 
 
 
 
 ''''looks for heading
      updatesheet.Select
    Rows("1:1").Select
    Selection.Find(What:="AACT QE", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
Dim begcolmpaste As Integer
 begcolmpaste = ActiveCell.Column
'''
 
 For Each cell In searchrange
 Dim searchcriteria As String
  lookupsheet.Select
 ActiveCell.Offset(1, 0).Select

  searchcriteria = ActiveCell.Value


 updatesheet.Select
 ActiveSheet.Range("$A:$AB").AutoFilter Field:=1, Criteria1:=searchcriteria
 lastrowlookup = updatesheet.Range("A1").End(xlDown).Row
 
 
lookupsheet.Select
ActiveCell.Offset(0, 22).Resize(RowSize:=1, ColumnSize:=4).Copy
updatesheet.Select

Range(Cells(lastrowlookup, begcolmpaste), Cells(lastrowlookup, begcolmpaste + 3)).Select
Selection.PasteSpecial Paste:=xlPasteValues
 


 counter = counter + 1
 Next
 'to take filter off after loop
   updatesheet.Select
 Rows("1:1").Select
 Selection.AutoFilter
 
  MsgBox ("Update Complete")
 
 
 
 'Enable Screen update and protect Complaints sheet
 
  Sheets("Complaints").Protect Password:="Secret"
  Application.ScreenUpdating = True
  End Sub