Alternative to Vlookup using macros

[Kemidan2014]

I am hoping this wonderful community can help me once again! with one problem of using Copy paste to paste on criteria from one work sheet another has been solved. i found that becuase my SOURCE worksheet for this task is 1000+ rows and 22 columns of Vlookups referencing a master file who will be overwritten as needed based on information we get from customers. This is causing a very long processing time for the newly added copy paste macro to work. i have found that if my Sheet 1 source data is just text it works INSTANTLY.

my solution needs to be my source sheet also needs to be a copy pasted data from our Masterfile instead of Vlookups. and as it wont be as easy as using the same macro.

I want to copy and paste all rows of data from my master file but i want to EXCLUDE certain columns because this information is irrelevent.

Source: Master file has headers in Row 1, 39 Columns and then Data below that about 1000+ rows of it and grows over time
Destination: Current working file "Sheet1" Same headers in Row 1 but only 23 of the columns of information that we want in this sheet

how would i target in VBA to only copy those specified columns and give me all the corresponding information below that column.

heres headers from source file

ToyotaData.xlsx
	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	AA	AB	AC	AD	AE	AF	AG	AH	AI	AJ	AK	AL	AM
1	QIMS#	Doc Type	Instance Handle Key	Rank	Supplier Code	TMMC Supplier Code	Supplier Name	Part Name	Part Number	Overall Status	NCD Description	QEName	Full Name	Full Name	Model	SQA Rank	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	Occurence	Where NC found?	Will Parts Be Quarantined ?	Why Made Category	Why Shipped Category	NAMC	ST/CM Status	LT/CM Status	Standard	Actual	Assigned To
Data

heres what i want to get to

Customer database test 2.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V
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
Sheet1

I apologize but due to nature of the info i cant publically share it. just assume there 1000+ rows of data in each cell below up and that will grow over time so lastrow will always be different.

 

[Kemidan2014]

Yes i tried that code and it would threw up Run time error 9 at
Set srcSH = Workbooks("ToyotaData.xlsx").Sheets("Data")

any ideas?

 

[DanteAmor]

Let's save the step of opening the file, first open the file and try the macro:

 

[DanteAmor]

Forget the previous post, I put here the code to open the file, try this new code.

Sub Update_trial_3()
  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
  
  Workbooks.Open ("O:\1_All Customers\Current Complaints\ToyotaData.xlsx")
  Set srcSH = Workbooks("ToyotaData.xlsx").Sheets("Data")
  Set desSH = Workbooks("Customer Database Test 2.xlsm").Sheets("sheet1")
  Set rng = srcSH.Range("A:B,D:E,H:K,O:O,Q:AB,AH:AH")
  
  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
  srcSH.Parent.Close False
End Sub

 

[Kemidan2014]

I was ahead of you on that gonna do that and the closing bit and see what happens aaanndd itt WORKS!!!!

I added a fake record and some extra dates and it picked up the new dates and added them in and changed the status and all updated correctly!

Thank you so much! this is resolved do you think theres any benefit to adding screenupdate true and false and begining or end?

 

[DanteAmor]

this is resolved do you think theres any benefit to adding screenupdate

Of course.

Sub Update_trial_3()
  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
  
  Workbooks.Open ("O:\1_All Customers\Current Complaints\ToyotaData.xlsx")
  Set srcSH = Workbooks("ToyotaData.xlsx").Sheets("Data")
  Set desSH = Workbooks("Customer Database Test 2.xlsm").Sheets("sheet1")
  Set rng = srcSH.Range("A:B,D:E,H:K,O:O,Q:AB,AH:AH")
  
  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
  srcSH.Parent.Close False

  Application.ScreenUpdating = True

End Sub

 

[Kemidan2014]

So i tried to add this into "Thisworkbook" as Workbook Open so that it would run automatically when i opened the workbook but i get an error any reason why it will function correctly as a module but not in "Thisworkbook"? Specifically i get a Compile Error

 

[DanteAmor]

So i tried to add this into "Thisworkbook" as Workbook Open so that it would run automatically when i opened the workbook but i get an error any reason why it will function correctly as a module but not in "Thisworkbook"? Specifically i get a Compile Error

Exactly what you want to do. Write here what the situation is. Which of the 2 books will contain the macro. Which book is going to be open, which one is going to be closed, etc.