CODEWITHSUNDEEP
vba
chrissik
chrissik

Reputation: 514

Extracting values from workbook based on criteria

So I got two workbooks. The first contains the source information. The second contains a list of products that should be completed with information from the source information.

So I thought this could be done with VBA. Here's my idea:

select the criteria-value from column B. search for the criteria in the source worksheet select the row where the matching criteria is (for example Row 4) select the cells of column Q and W in the matching row and copy those values back in the cells E and F of the product workbook in the row where the criteria is.

Is there any chance that this can be realised in VBA? And do you have any tips to help me? Thank you in advance!

Upvotes: 0

Views: 801

Answers (1)

Sylvain
Sylvain

Reputation: 158

If the criteria cells are strictly the same in both workbooks, I suggest creating an array with the criteria of your source sheet, then looping through the product sheet to add the 2 columns you require in your array. You would only need to loop again through the source sheet and replace the destination cells with the relevant data. If the sort order has no importance, or can be reset, I would suggest sorting on your criteria column to optimize with a single For... Next loop.

If your criteria cells are not strictly the same, is there a pattern you can reuse?

An easy code example would be as such:

Sub CopyData()
Dim myData(200, 3) As Variant
Dim i As Integer
Dim iArrayLimit As Integer
Dim myLastRow As Integer

Application.Workbooks(Source).Activate
myLastRow = ActiveCell.SpecialCells(xlCellTypeLastCell).Row
iArrayLimit = myLastRow
For i = 1 To myLastRow 'Provided your source sheet has no header. Replace by 2 if it does!
 myData(i, 1) = Cells(i, 2) 'Column B, right
Next

Application.Workbooks(Products).Activate
myLastRow = ActiveCell.SpecialCells(xlCellTypeLastCell).Row
For i = 1 To iArrayLimit 'Take care: if you have headers here and not in the source, change the code below
 For j = 1 To myLastRow
  If Cells(j, 1) = myData(i, 1) Then 'If your criteria in the products sheet is in column A!
   myData(i, 2) = Cells(j, 17)
   myData(i, 3) = Cells(j, 23)
   Exit For
  End If
 Next
Next

Applications.Workbooks(Source).Activate
For i = 1 to iArrayLimit
 Cells(i, 5) = myData(i, 2)
 Cells(i, 6) = myData(i, 3)
Next

End Sub

Upvotes: 1

Related Questions