Solved: find same value in two different lists and copy cells in new sheet

[Andrea C]

Hi, I apologize in advance if this question has already been posted. I have searched but it is possible that I missed it.
I am completely new to VBA and Macros, and not a expert in Excel, so this is a huge problem for me. Here's what I am trying to accomplish.
I have data that is refreshed from two queries, creating two different lists, which contain some of the same criteria, and some different ones.
So on the sheet "Pulled Data" I have my list 1 from columns A to N.
And my list 2 from columns P to Y.
Since these are from queries, the number of rows changes evberytime the queries are updated.
I want to look through column J and column P, and if any of the values in column P are equal to the one in column J, Row 1, then copy A-N of row 1 in a sheet named "Run" and copy the row for which the value matches from P to Y below in the sheet "Run", then I would like fo rit to check for the value in Column J, Row 2 & Do the same thing, etc... Until it checks all of the rows with values in column J.

Please let me know if this makes sense or if you need more information.

Thanks in advance for your time & help.
Regards, Andrea.

[GTO]

Greetings Andrea,

Welcome to to the forum :) and a Howdy from Arizona. You have picked a mighty "Cool" forum to join, and I'm sure you'll enjoy it.

In a Standard Module:

Option Explicit

Sub FindMatches()
Dim _
wksSource As Worksheet, _
wksDest As Worksheet, _
rngLRColJ As Range, _
rngLRColP As Range, _
rngColJ As Range, _
rngColP As Range, _
rngDestFRow As Range, _
rCell As Range, _
rngFind As Range, _
lDestFRow As Long

'// Set a reference to both sheets; change the names in the quotes as neeeded. //
Set wksSource = ThisWorkbook.Worksheets("Pulled Data")
Set wksDest = ThisWorkbook.Worksheets("Run")

'// With "Pulled Data" sheet//
With wksSource
'// Find the last cell in Columns J|P and set a reference to these cells. //
'// If nothing is found, the reference will remain Nothing. //
Set rngLRColJ = .Range("J:J").Find(What:="*", _
After:=.Range("J1"), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)

Set rngLRColP = .Range("P:P").Find(What:="*", _
After:=.Range("P1"), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)

'// Just in case we don't have any vals, provide an exit. //
If rngLRColJ Is Nothing _
Or rngLRColP Is Nothing Then
Exit Sub
End If

'// Set refererences to the ranges we'll be looping thru or searching. //
Set rngColJ = .Range("J1:J" & rngLRColJ.Row)
Set rngColP = .Range("P1:P" & rngLRColP.Row)

'// For ea cell's value in the J Column range... //
For Each rCell In rngColJ
'// ...search for the cell's value in Col P... //
Set rngFind = rngColP.Find(What:=rCell.Value, _
After:=rngColP(1, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)

'// If NOT ... Is NOTHING means we found it. If we don't find a match, //
'// we just skip by this and go (loop) and look for the next cell's val //
If Not rngFind Is Nothing Then
'// Find the last used row in our destination sheet, so we know //
'// where to kaplun in the data. //
Set rngDestFRow = wksDest.Range("A:A").Find(What:="*", _
After:=wksDest.Range("A1"), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)
'// If we didn't find any data in Col A of the destination sheet, it//
'// must be clean, so copy to row 1; else, go down (the +1) one row //
'// from where the last data was pasted. //
If rngDestFRow Is Nothing Then
lDestFRow = 1
Else
lDestFRow = rngDestFRow.Row + 1
End If

'// maybe time to read the help topics, but basically, we're snagging//
'// the cells to the side(s) of our matches, and copying (if I read //
'// correctly) the ranges over to the dest sheet. //
rCell.Offset(, -9).Resize(, 14).Copy wksDest.Range("A" & lDestFRow)
rngFind.Resize(, 9).Copy wksDest.Range("P" & lDestFRow)
End If
Next
End With
End Sub


I think you need 5 posts to before you can include an example file as an atachment, so I attached a small example. See if that looks like what you are trying to do.

Have a great night,

Mark

[mdmackillop]

Hi Mark,
You can post attachments at any time, but you need posts to inset a hyperlink.
Regards
Malcolm

[GTO]

Oops!:doh:

Too many things for my pea-brain to rememeber:rotlaugh: (I don't mean here, just life in general)

Thanks Malcom :-)

Mark

[Andrea C]

Hey Mark,
First of all, thanks!
They idea is correct, and this is really helpful. I think I just need to be a bit clearer on what I need.
I modified the way the data was pulled from the query to make it easier on what I am trying to do.
So I have the two data sets.
Set 1 (Columns A to N)
Set 2 (Columns P to AC)
I want to search through Recipe (column M), only if there is a blank in column N.
so for this example, I would only search through the column M until row 15. And then find if there are any matching recipes (column M) in Column AB.
If there are, then take all rows, columns A-N containing that recipe and copy to Run Sheet, Then, take the rows matching the same recipe and copy Columns P to AC below the rows we just copied from Set 1.
If there are no matching recipes from Set 1 on Set 2, then, Just copy columns A-N to Run Sheet and look for the next Recipe in Column M. (This is the case for recipe M-200X in the spreadsheet attached). Please remember that this only needs to be done if the cell in column N is blank. I don’t care about the data in the rows where a Machine is assigned (Column N has a value).
And for the rest of recipes, that are on Set 2 but do not have a matching Recipe on set 1, just copy them to the bottom of the list we are creating on Run sheet.
I would also like for the Run Sheet to have the same headings all the time.
So I can see how adding the new data to the bottom of the Run Sheet would be great, but for my purposes, it would be better if every time the query is pulled and the macro is run, the data on Run is completely refreshed. (So Just the headings will stay the same every time)
Please look at the file attached (hopefully it will make more sense!)
Thanks again for you time, advice and patience with this VBA and Macro rookie! :)
I greatly appreciate it.
-Andrea.

[GTO]

Greetings Andrea,

I looked at the attached file and am afraid I am quite lost:eek:


...I modified the way the data was pulled from the query to make it easier on what I am trying to do.

So I have the two data sets.

Set 1 (Columns A to N)
Set 2 (Columns P to AC)

I want to search through Recipe (column M), only if there is a blank in column N.

so for this example, I would only search through the column M until row 15. And then find if there are any matching recipes (column M) in Column AB. ...


Column M has a sub heading of 'FD212' and some values of "x" in the rows below. I do not see anything at all in Column AB...

Might have you posted the wrong sheet?

Mark

[Andrea C]

I'm so sorry... I posted the wrong one.. .
This is the correct one.

Thanks!
Andrea

[Andrea C]

Hi, I'm sorry to be of such bother, but can anyone help me with this code? It is urgent that I have this ready fo rmy job.

Thanks again,
Andrea.

[mdmackillop]

Try this

[Andrea C]

Hey! Thanks, this works, but I am not sure why it is not grouping the data correctly. So on test_V2, I ran the macro with the actual data and in the Run sheet, the results should actually be organized in the following way:
Rows 2-5 are perfect because there is no match for M-030X in Set 2.
Row 6 is fine because it is the following recipe in column M.
Then, Row 9 should be below current Row 6 (because they have the same recipe), and current row 7 should be below that, and current rows21-26 should be below current row 7.
The rest which do not have matching Recipes in data set 1, are fine after we have grouped all the matching ones together.
In other words, I need to create a "Group" or place the rows with the same recipe from both data seta together on the run spreadsheet so I can manipulate it some more from there.
* Please see attached file*
Thank you soo much for your help & time..
I really appreciate it.
-Andrea

[mdmackillop]

In what way does my code result not match your "Run" solution?

[Andrea C]

Hello,
If I copy the new data into the file and click the button, the recipes are not grouped together. I just deleted the old data and did copy-paste with the new data, and clicked the button. I don't know if I messed soemthing up, but I didn't even go to the code. I am attaching the file so you can see the results with the new data.


Rows 2-5 are perfect because there is no match for M-030X in Set 2.
Row 6 is fine because it is the following recipe in column M.
Then, Row 9 should be below current Row 6 (because they have the same recipe), and current row 7 should be below that, and current rows21-26 should be below current row 7.
The rest which do not have matching Recipes in data set 1, are fine after we have grouped all the matching ones together.
In other words, I need to create a "Group" or place the rows with the same recipe from both data seta together on the run spreadsheet so I can manipulate it some more from there.


Thanks, Andrea.

[mdmackillop]

A minor problem with the Find code. Try this

[Andrea C]

Hi!
Thank you, it works great. However, when I update the data, and run the code it gave me the following error. With the part that is in pink highlighted in yellow.
Please see attached file.

For i = 0 To dic.Count - 1 'Iterate the array
With wsData.Columns("M:N")
.AutoFilter Field:=1, Criteria1:=a(i)
.AutoFilter Field:=2, Criteria1:="="
Data1.SpecialCells(xlCellTypeVisible).Copy wsRun.Cells(Rows.Count, 1).End(xlUp).Offset(1)
.Columns("M:N").AutoFilter
End With

Thanks again,Andrea

[mdmackillop]

Remove the Filter from your data, then try again.

[Andrea C]

Hey, I don't know how the filters got there or how to take them out so that this doesn't happen in the future.. but what I did was I started a new sheet, embedded the queries, and copy/paste your macro. Then I added a button and linked it to the macro.However, I get the same button on the Run sheet, and even if I delete it, when I run the macro again, it appears again. Any idea why?:doh:
I also found this piece of code that will clear the worksheet of any filters (i think):think: -- again I don't understand any of this! :( can I add this to the beginning of your code, so that when the people are using this, the filter thing doesn't happen?

Here's the code I found:
Sub fileterAuto()
If ActiveSheet.AutoFilterMode Then
ActiveSheet.autoFilter.range.autoFilter
End If
End Sub


I'm sorry to be such a pain, but on the run sheet, I also need to color code the rows that have the same recipe... like row 2- 13 (recipe: T-030X) have background green, then 14-16 (recipe: M-030X) have no background, then rows 17-18 (recipe: M-200X) have the green background.. etc... is this possible to automate?

Thanks a million again,
Andrea.

[mdmackillop]

For the button issue, set the Button Property to Do Not Move or Size with cells.
I've incorporated code to remove any autofilter.
Your data contains error values. These are changed to "Error" by the code. I don't know if this is suitable.


Option Explicit
Sub Extract()
Dim wsRun As Worksheet
Dim wsData As Worksheet
Dim cel As Range
Dim Recipe As Range
Dim c As Range
Dim Data1 As Range
Dim Data2 As Range
Dim dic, a, i As Long
Dim Rng As Range
Application.ScreenUpdating = False
Set wsRun = Sheets("Run")
Set wsData = Sheets("Pulled Data")

With wsData
.AutoFilterMode = False
Set Data1 = Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp)).Resize(, 14)
Set Data2 = Range(.Cells(2, 16), .Cells(Rows.Count, 16).End(xlUp)).Resize(, 14)
Set Recipe = Range(.Cells(2, 13), .Cells(Rows.Count, 13).End(xlUp))
End With
With Range(wsRun.Cells(2, 1), wsRun.Cells(Rows.Count, 14))
.ClearContents
.Interior.ColorIndex = xlNone
End With

Set Rng = Intersect(Recipe.Resize(, 2), Recipe.Offset(, 1).SpecialCells(xlCellTypeBlanks))
Set Rng = Rng.Offset(, -1)
'Get list of unique items
Set dic = CreateObject("Scripting.Dictionary")
On Error Resume Next
For Each cel In Rng
dic.Add cel.Text, cel.Text
Next
On Error GoTo 0
a = dic.Items 'Get the items
For i = 0 To dic.Count - 1 'Iterate the array
With wsData.Columns("M:N")
.AutoFilter Field:=1, Criteria1:=a(i)
.AutoFilter Field:=2, Criteria1:="="
Data1.SpecialCells(xlCellTypeVisible).Copy wsRun.Cells(Rows.Count, 1).End(xlUp).Offset(1)
.Columns("M:N").AutoFilter
End With
Set c = wsData.Columns(28).Find(a(i), LookIn:=xlValues)
If Not c Is Nothing Then
wsData.Columns(28).AutoFilter Field:=1, Criteria1:=a(i)
Data2.SpecialCells(xlCellTypeVisible).Copy wsRun.Cells(Rows.Count, 1).End(xlUp).Offset(1)
wsData.Columns(28).AutoFilter
End If
Next
'Get list of unique items
Set dic = Nothing
Set dic = CreateObject("Scripting.Dictionary")
On Error Resume Next
For Each cel In Range(wsData.Cells(2, 28), wsData.Cells(Rows.Count, 28).End(xlUp))
dic.Add cel.Text, cel.Text
Next
On Error GoTo 0
a = dic.Items 'Get the items
For i = 0 To dic.Count - 1 'Iterate the array
Set c = Rng.Find(a(i), LookIn:=xlValues)
If c Is Nothing Then
wsData.Columns(28).AutoFilter Field:=1, Criteria1:=a(i)
Data2.SpecialCells(xlCellTypeVisible).Copy wsRun.Cells(Rows.Count, 1).End(xlUp).Offset(1)
wsData.Columns(28).AutoFilter
End If
Next
i = 0
For Each cel In Range(wsRun.Cells(2, 13), wsRun.Cells(Rows.Count, 13).End(xlUp))
If IsError(cel) Then cel.Value = "Error"
If cel <> cel.Offset(-1) Then i = i + 1
If i Mod 2 = 1 Then cel.Offset(, -12).Resize(, 13).Interior.ColorIndex = 35
Next
Application.ScreenUpdating = True
End Sub

[Andrea C]

Thank you soo much! It works like a charm!
I am sure I will have something else along the way (given that my VBA skills are so limited) but I've already started with a couple of free tutorials on-line. If you have any particular learning material that would be good for a newbie, please let me know.
Thanks again, :thumb
Andrea.

[Andrea C]

Hey, sorry I keep bothering, but as I work with the file I keep finding roadblocks. :banghead:
Anyway, here's what's going on now, any help is appreciated.

I know I mentioned earlier that I did not need the data that has a machine assigned (column N) from list 1, but as it turns out, I do need this data. If it could be copied to the Run Sheet after all of the other rows, regardless of whether it has matching recipe with any data from list 2 or not. Also, if this data that was imported can be color coded like the previous ones, by recipe to make the group distinguishable (one green, other white, then green, etc.)

Then, can the color formats be extended to the entire row? So that we I add the formulas I need after the data, I still know which ones are on the same group?

oh!, That goes hand in hand with the numbers that we import into the Run sheet are stored as text, not numbers, therefore my formulas don't work. Is there anything we can add to the code so the numbers can be changed from being stored as text to number format after they are compiled in the run sheet?

Another little thing, can formulas be automatically added to cells after the data that I pull from th equerry is refreshed? I have some formulas that go in some columns that fall in between the returned range of cells, but when I update the data, the formulas disappear... Is there anything for this that can be included?

Thank you once again!


-Andrea.