VBA to Find Match and Copy Cells to another workbook

lxondecks

New Member
Joined
Sep 23, 2020
Messages
7
Office Version
  1. 2016
Platform
  1. Windows
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
 

Some videos you may like

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.

Bmort

New Member
Joined
Sep 23, 2020
Messages
7
Office Version
  1. 365
  2. 2013
Platform
  1. Windows
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:
keyvalue
09/1/20203
09/2/20206
09/3/20205
09/4/20206

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

New Member
Joined
Sep 23, 2020
Messages
7
Office Version
  1. 2016
Platform
  1. Windows
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

New Member
Joined
Sep 23, 2020
Messages
7
Office Version
  1. 365
  2. 2013
Platform
  1. Windows
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.

 

lxondecks

New Member
Joined
Sep 23, 2020
Messages
7
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,559
Office Version
  1. 365
Platform
  1. Windows
You can use
VBA Code:
Dic(Cl.Value) = Cl.Offset(, 1).Resize(, 4).Value
and then
VBA Code:
If Dic.Exists(Cl.Value) Then Cl.Offset(, 2).Resize(, 4).Value = Dic(Cl.Value)
 

lxondecks

New Member
Joined
Sep 23, 2020
Messages
7
Office Version
  1. 2016
Platform
  1. Windows
Perfect guys. Thanks for your help, working great!
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,559
Office Version
  1. 365
Platform
  1. Windows
Glad we could help & thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,610
Messages
5,625,804
Members
416,138
Latest member
Pizzaman22

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top