Find then VlookUp and copy to new sheet

I am currently stumped on how to do this and I am not even sure it is doable.

We have two files that come in that are then pasted onto a spreadsheet on two separate tabs. For the purpose of my question I have called them Data1 and Data2.

I need to VLookUp cell[s] 'C' in Data1 and check if they appear in Data2 in 'J' If they do the entire row plus header from Data1 needs to be copied to the Tab 'Result'

Beneath that I need the header from Data2 and the corresponding item[s] in Data2 that are in Data1.

I have included an example spreadsheet which shows how the 'result' tab should look. I have highlighted in Red the Ref that identifies the items. Although I do not need the Macro to highlight these.

Is there anyone out there up for this challenge?

Thanks
VLookUp.xlsx
JagwarmanAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

KimputerCommented:
See code below. Please note I used Excel 2003 which showed a bit of unwanted behaviour. While testing, keep Task manager open, and monitor Excel's memory usage. Sometimes it will stay in there even though you closed Excel. Hopefully you will still save time, even if you have to keep an eye on it. Or even better, hopefully you won't notice anything at all with a newer Excel version.
Newer Excel might require one edit:

objExcel.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & Application.ActiveWorkbook.FullName & ";" & "Extended Properties=""Excel 12.0;HDR=Yes;"";"

Open in new window




Sub test()

Const adOpenStatic = 3
Set objExcel = CreateObject("ADODB.Connection")
objExcel.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & Application.ActiveWorkbook.FullName & ";" & "Extended Properties=""Excel 8.0;HDR=Yes;"";"
Set objRS1 = CreateObject("ADODB.Recordset")
Set objRS2 = CreateObject("ADODB.Recordset")
objRS1.Open "Select * FROM [Data1$A:K]", objExcel, adOpenStatic
resultscounter = 1

Do While Not objRS1.EOF
    
    objRS2.Open "Select * FROM [Data2$A:J] where Header10 = """ & objRS1.fields(2).Value & """", objExcel, adOpenStatic
    header1 = 0
        Do While Not objRS2.EOF
        
            If header1 = 0 Then
                header1 = 1
                fillheader1 resultscounter, objRS1
                ActiveWorkbook.Sheets("Result").Activate
                resultscounter = resultscounter + 3
                fillheader2 (resultscounter)
                resultscounter = resultscounter + 1
                fillheader3 resultscounter, objRS2
                resultscounter = resultscounter + 1
            Else
                fillheader3 resultscounter, objRS2
                resultscounter = resultscounter + 1
            End If

            objRS2.MoveNext
        Loop
        
    objRS2.Close
    If header1 = 1 Then
        resultscounter = resultscounter + 1
    End If
    objRS1.MoveNext
Loop

objRS1.Close

End Sub

Sub fillheader1(rownumber, rs)
ActiveWorkbook.Sheets("Result").Activate
Cells(rownumber, 1).Value = "Name1"
Cells(rownumber, 2).Value = "Name2"
Cells(rownumber, 3).Value = "Name3"
Cells(rownumber, 4).Value = "Name4"
Cells(rownumber, 5).Value = "Name5"
Cells(rownumber, 6).Value = "Name6"
Cells(rownumber, 7).Value = "Name7"
Cells(rownumber, 8).Value = "Name8"
Cells(rownumber, 9).Value = "Name9"
Cells(rownumber, 10).Value = "Name10"
Cells(rownumber, 11).Value = "Name11"
Cells(rownumber + 1, 1).Value = rs.fields(0).Value
Cells(rownumber + 1, 2).Value = rs.fields(1).Value
Cells(rownumber + 1, 3).NumberFormat = "@"
Cells(rownumber + 1, 3).Value = rs.fields(2).Value
Cells(rownumber + 1, 4).Value = rs.fields(3).Value
Cells(rownumber + 1, 5).Value = rs.fields(4).Value
Cells(rownumber + 1, 6).Value = rs.fields(5).Value
Cells(rownumber + 1, 7).Value = rs.fields(6).Value
Cells(rownumber + 1, 8).Value = rs.fields(7).Value
Cells(rownumber + 1, 9).Value = rs.fields(8).Value
Cells(rownumber + 1, 10).Value = rs.fields(9).Value
Cells(rownumber + 1, 11).Value = rs.fields(10).Value
End Sub

Sub fillheader2(rownumber)
ActiveWorkbook.Sheets("Result").Activate
Cells(rownumber, 1).Value = "Header1"
Cells(rownumber, 2).Value = "Header2"
Cells(rownumber, 3).Value = "Header3"
Cells(rownumber, 4).Value = "Header4"
Cells(rownumber, 5).Value = "Header5"
Cells(rownumber, 6).Value = "Header6"
Cells(rownumber, 7).Value = "Header7"
Cells(rownumber, 8).Value = "Header8"
Cells(rownumber, 9).Value = "Header9"
Cells(rownumber, 10).Value = "Header10"

End Sub


Sub fillheader3(rownumber, rs)
ActiveWorkbook.Sheets("Result").Activate
Cells(rownumber, 1).Value = rs.fields(0).Value
Cells(rownumber, 2).Value = rs.fields(1).Value
Cells(rownumber, 3).Value = rs.fields(2).Value
Cells(rownumber, 4).Value = rs.fields(3).Value
Cells(rownumber, 5).Value = rs.fields(4).Value
Cells(rownumber, 6).Value = rs.fields(5).Value
Cells(rownumber, 7).Value = rs.fields(6).Value
Cells(rownumber, 8).Value = rs.fields(7).Value
Cells(rownumber, 9).Value = rs.fields(8).Value
Cells(rownumber, 10).NumberFormat = "@"
Cells(rownumber, 10).Value = rs.fields(9).Value

End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
JagwarmanAuthor Commented:
Kimputer thanks for this unfortunately I get a runtime error Invalid internet address in line

objExcel.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & Application.ActiveWorkbook.FullName & ";" & "Extended Properties=""Excel 8.0;HDR=Yes;"";"

Regards
0
KimputerCommented:
Yes, look at the top of my original post, the replacement line is there.
0
10 Tips to Protect Your Business from Ransomware

Did you know that ransomware is the most widespread, destructive malware in the world today? It accounts for 39% of all security breaches, with ransomware gangsters projected to make $11.5B in profits from online extortion by 2019.

JagwarmanAuthor Commented:
Hi Kimputer,

it works fine when I try it out on the test file but when I put the code into my live file [changing the name tabs and range to that in my file] I am getting an error

'Run-time error '-2147217904 (80040e10)':

No Value Givenfor one or more required parameters

objRS2.Open "Select * FROM [Data2$A:J] where Header10 = """ & objRS1.Fields(2).Value & """", objExcel, adOpenStatic

Thanks
0
KimputerCommented:
Header name is VERY important in this syntax. The test file started with Header10, your live file probably has another name. Please adjust it in that line (replace the code Header10 to what's filled in your live file.
0
JagwarmanAuthor Commented:
Hi Kimputer

Thanks for this. It does exactly what I asked for. Brilliant.
0
JagwarmanAuthor Commented:
Thanks for this. It does exactly what I asked for. Brilliant.
0
JagwarmanAuthor Commented:
Kimputer, is it possible to restrict to to a range rather than looking at the whole sheet. Say from row 1 to row 2000

Thanks
0
KimputerCommented:
Assuming you mean from sheet Data1,

find the first line with

objRS1.Open

and change it to

objRS1.Open "Select * FROM [Data1$A1:K2000]", objExcel, adOpenStatic
0
JagwarmanAuthor Commented:
Thanks Kimputer
0
JagwarmanAuthor Commented:
Kimputer

Don't know if you will pick this up but I have a problem with this code now for some reason.

When I run it against the file I attached it falls over with runtime error Invalid internet address irrespective of if I use

objExcel.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & Application.ActiveWorkbook.FullName & ";" & "Extended Properties=""Excel 12.0;HDR=Yes;"";"
 or the other line


When I run it with my file it falls over with Variable not defined at:

Set objExcel = CreateObject("ADODB.Connection")

Is it possible you could help me out with this please?

Thanks in advance.
0
KimputerCommented:
Retested, can't reproduce the error. Is it the only open Excel file ? Did you add more code to this file other than what was described here ?
Since you didn't attach another file, I think you mean the original file?
0
JagwarmanAuthor Commented:
Hi Kimputer, Thanks for taking a look. I have attached the file I tested on today which gave me the error.

Did you add more code to this file other than what was described here ?
I did not make any changes.

Regards
Copy-of-VLookUp.xlsm
0
KimputerCommented:
I'm afraid something happened on your computer then. Can you test on another PC? Because even with the new attached file, I cannot reproduce any errors.
0
JagwarmanAuthor Commented:
Hmm! ok thanks I hope I can get this soreted as it is very key to the process
0
KimputerCommented:
I even thought it was some reference problem, but it doesn't need references at all (besides the two already checked when you start Excel VBA, which you also cannot uncheck anyway).
I can only reproduce some error but on the next line (objExcel.Open...) if I set the file to read only (which in your case could be a file permission problem)
0
JagwarmanAuthor Commented:
Ok thanks Kimputer I will look at it over the weekend.

Regards
0
JagwarmanAuthor Commented:
One thought I had on the way home is that my version of Excel 2010 was upgraded to 'professional' would that have anything to do with it?
0
KimputerCommented:
Still stumped. I was testing with Excel 2007, but since you mentioned 2010, I tested on a fresh install, still didn't see any errors with the last file.
The "Professional" shouldn't have had an impact on your how your Excel functions. Can you try the Repair function (admin should do it, through the Control panel > Programs) ?
0
JagwarmanAuthor Commented:
will try that first thing Monday. I will keep you posted.

Regards
0
JagwarmanAuthor Commented:
I think the problem is that in Excel Professional in References - VBA Project 'Microsoft Office 14.0 Object Library' is ticked. I presume this is a newer version up from 'OLEDB.4.0 and 12' ??  I thought I would ask my HelpDesk to put me back to my original Excel Version of 2010.


But I am also experiencing another problem. I believe it relates to what you said "While testing, keep Task manager open, and monitor Excel's memory usage. Sometimes it will stay in there even though you closed Excel."

I am getting "Excel cannot complete this task with the available resources. Choose less data or close other applications"

In fact I have nothing else open. So although the Macro is great and does exactly what I asked for, it seems I might not be able to use it.

Any ideas.
0
JagwarmanAuthor Commented:
Kimputer

"Excel cannot complete this task with the available resources. Choose less data or close other applications" was a 'Red herring' and nothing to do with this Macro. [Sorry about that]

However, the other error I am getting is "variable not defined" at 'objExcel' in 'Set objExcel = CreateObject("ADODB.Connection")'
0
KimputerCommented:
Before the line Set objExcel = ..
Insert this:

Dim objExcel

(although I still can' recreate the error, even though I don't have that line in my code)
0
JagwarmanAuthor Commented:
tried that Kimputer but then it moves onto the next one

Set objRS1 then

Set objRS2 then

resultscounter = 1 Then

header1

Bizzare if I put DIM in front of each of these it seems to work.

I will try it out again tomorrow.
0
JagwarmanAuthor Commented:
Kimputer [Happy New Year]

Unfortunately I am still having problems with this.

I am getting Invalid Internet address at this point:

objExcel.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & Application.ActiveWorkbook.FullName & ";" & "Extended Properties=""Excel 12.0 Macro;HDR=Yes;"";"

I hava also tried using this, but same error code:
objExcel.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & Application.ActiveWorkbook.FullName & ";" & "Extended Properties=""Excel 8.0;HDR=Yes;"";"

Would you be able to resolve this error or should I repost my original question
Thanks
Regards
0
KimputerCommented:
Sounds like you are using a network file ? Is that really necessary ? Can't you try copying it to your hard disk, run the code, and put it back on the server (if that's even necessary)? Even if it's not what you want as your final solution, at least it's a step further in tracing the error.
0
JagwarmanAuthor Commented:
Kimputer, thanks for getting back. It looks like it may well be what you say as it goes passed that piece of code now but..... :-(

I am now getting error :

Run-time error '-2147467259 (80004005)'

the connection for viewing your linked microsoft excel worksheet was lost

at this point : objRS1.Open "Select * FROM [DTCC SOI$A:Q]", objExcel, adOpenStatic

Any ideas?

Thanks
0
JagwarmanAuthor Commented:
Kimputer

The bizarre thing is when I run the 'Test' file which is saved in the same place that one works fine ??????
0
KimputerCommented:
Can you rename your sheet to DTCC, and adjust it in the code as well? a.i. FROM [DTCC$A:Q]
0
JagwarmanAuthor Commented:
This is the most bizarre thing I have ever come across. Works [for now]

Thanks Kimputer
0
KimputerCommented:
If you want to keep using sheet names with spaces, you can change it back and change the code to:
FROM ['DTCC SOI'$A:Q]

Open in new window


I would keep using no space though, keeps your code more neat, so better try DTCC_SOI instead if you really need more names.
0
JagwarmanAuthor Commented:
Thanks Kimputer will give that a try
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Applications

From novice to tech pro — start learning today.