VBA to Find Match and Copy Cells to another workbook

[lxondecks]

Hi All, First post here. I have been searching for a while for some VBA code to achieve what i need but i have not had any luck yet.

I have two workbooks WB1 and WB2
Each workbook has the date with Column A
I need the VBA code to find a match of the date in Column A within WB1 and WB2
If a match is found, then the values within the matched date row, Column (B:E) should be copied from WBK1 to WB2 Column (C:F) within the corresponding matched date row.

The only thing I have managed to find that matches cells and copies data is the below code.
However this
- Only copes the Value in 1 column where I need a range.
-Only copies data within the same workbook
-Takes a while for the data to populate (maybe as I have over 9000 lines of data)

Any assistance would be much appreciated. Thank you!

Sub COPY_DATA_FORECAST()
Dim Cl As Range
Dim Dic As Object

Set Dic = CreateObject("scripting.dictionary")
'Searches date range within Column A and copy data from next column
With Sheets("sheet1")
For Each Cl In .Range("A3", .Range("A" & Rows.Count).End(xlUp))
Dic(Cl.Value) = Cl.Offset(, 1).Value
Next Cl
End With
With Sheets("Sheet2")
For Each Cl In .Range("A20", .Range("A" & Rows.Count).End(xlUp))
If Dic.exists(Cl.Value) Then Cl.Offset(, 2).Value = Dic(Cl.Value)
Next Cl
End With
End Sub

 

[Bmort]

The issue you're having is related to how you're storing the data to compare, and how you're referencing it later on. It sounds like you intend to copy an entire row or more than one column from one sheet to another.

In your first loop, you're adding a key value pair to a dictionary. you're using CI.Value as the "Key" and CI.Offset(,1).Value as the "Value).
As an example:

key	value
09/1/2020	3
09/2/2020	6
09/3/2020	5
09/4/2020	6

If (in any case) you have a duplicate "key" (date in your case) you're going to be overwriting the "value" with a different value- so you may want to rethink how you're comparing between each sheet.

For the second loop- you're checking if that date exists in the dictionary that you created in the first loop- and if so, then you set the value in the second sheet to the value in the dictionary where the "key" is the date from the first sheet. I don't think this is your intended result and that you intend to copy an entire row or multiple columns from the first sheet.
If this is the case, then I would suggest that you use the "key" to retrieve the matching row in the original sheet. (Again this only works if you do not have duplicate dates in the first sheet)- unless you would want to copy all data that matches with that date. Then you'd do a loop to find each occurrence of the "matched" date in the first sheet and then copy the matching rows to the second sheet.

In order to speed up processing, you'll want to turn off screen updating while the code is processing through all the records.

add this line to the beginning of your macro:
Application.ScreenUpdating = False

and this line to the end:
Application.ScreenUpdating = True

Lastly, in order to reference another workbook, you can use the workbooks object to reference another workbook.
Workbooks("otherfile.xlsx").Sheets("Sheet1") for example.

Hopefully that points you in a better direction.

 

[lxondecks]

Thank you for your reply Bmort. I will apply the changes for Application.Screen updating and Workbooks objects.

The issue im now struggling with is the required modification for the Value cell CI.Offset(,1).Value
This currently takes the value from Column B. As you have said, I am trying to copy data from multiple columns from the matched Row, but not the entire row.

Are you able to offer any guidance on how i could apply your suggestion

I would suggest that you use the "key" to retrieve the matching row in the original sheet.

To confirm, the date fields in Column A will not have duplicates as these are sequential YYYY-MM-DD, with a new row added each day to each workbook.

Thanks!

 

[Bmort]

I'd suggest using the match function to get the index of the row in the original sheet in your loop and reference the columns with the offset like you're doing, and set each value separately CI.Offset(,1) CI.Offset(,2), etc. using the offset values that you get using the index match.

VBA Match

We have Index and Match in the worksheet as lookup functions. In addition, we can also use Match functions in VBA as a lookup function. This function is a

www.wallstreetmojo.com

 

[lxondecks]

Thank you, I have copied the loop for each column offset i require. However even with the Application.ScreenUpdating = False , it still takes a couple of minutes for the process to complete.
I think its slow as its matching the date, collecting 1 value and saving it to the dictionary, then copying it the sheet 2 where a date match is found.

Is it possible to create something along the lines of the below, so that the dictionary collects multiple values for the "key" date and then these multiple values can be copied acros to sheet 2 where a match is found with the "key" date??

Dic(Cl.Value) = Cl.Offset(, 1)&Cl.Offset(, 2)&Cl.Offset(, 3)&Cl.Offset(, 4).Value

The good thing is that the code is working how i need it too, but is threre is a way to copy multiple values, im hoping it could speed things up a little.

Thank you for your help on this. As I'm sure you have gathered, I don't have much knowledge of VBA!

 

[Fluff]

You can use

Dic(Cl.Value) = Cl.Offset(, 1).Resize(, 4).Value

and then

If Dic.Exists(Cl.Value) Then Cl.Offset(, 2).Resize(, 4).Value = Dic(Cl.Value)

 

[lxondecks]

Perfect guys. Thanks for your help, working great!

 

[Fluff]

Glad we could help & thanks for the feedback.