PDA

View Full Version : [SOLVED] Find, copy & paste



blackie42
04-14-2014, 08:24 AM
Hi,

Was hoping someone can help with a tricky transfer of details..

I have a list of accounts in column B in sheet 1

In sheet 2 some of these accounts are repeated in column B and there are further details in columns C, D & E.

I would like to run a macro that runs through col B in sheet 1 and if finds a match in sheet 2 it copies and pastes C,D & E in to sheet1 adjacent to the same account.


Any help appreciated
thanks

ashleyuk1984
04-14-2014, 08:52 AM
You could achieve the same result by just using VLookup :)

Do you know how to use VLookup?

jolivanes
04-14-2014, 08:26 PM
Like ashleyuk1984 said, usually fomulae and native functions are the way to go.
However, if you do want a macro, try this on a copy of your workbook.

Sub Get_Offset_Values()
Dim sht1 As Worksheet, sht2 As Worksheet
Dim fnd As Range, LastRow As Long, r As Long
Set sht2 = Sheets("Sheet2")
Set sht1 = Sheets("Sheet1")
LastRow = sht1.Cells(Rows.Count, "B").End(xlUp).Row
For r = 2 To LastRow 'change 2 to 1 if you don't have headers
Set fnd = Nothing
Set fnd = sht2.Cells.Find(sht1.Cells(r, "B"), , , xlWhole)
If Not fnd Is Nothing Then fnd.Offset(, 1).Resize(, 3).Copy sht1.Cells(r, 3)
Next r
End Sub

blackie42
04-15-2014, 12:25 AM
Thanks for your help guys - macro works fine. Not used Vlookup for a while but will give that a try too

regards

ashleyuk1984
04-15-2014, 01:48 AM
If you require any help with the VLookup you know where we are :)

blackie42
04-15-2014, 06:26 AM
Hi AshleyUK,

Could you remind me how to achieve this with Vlookup.

I changed the macro slightly as I need to copy cols C,D,E & F from sheet2 in to cols M,N O & P in sheet1 using colB as the common denominaoe in both sheets. Macro does work but hangs - assume it would take hours to complete since there are a lot of entries to wade through.

many thanks

ashleyuk1984
04-15-2014, 07:50 AM
When the macro hangs for agesssssssss, it could be because it's in an unbreakable loop.
A macro should take no longer than a few seconds (minutes at most) to complete.

Anyway...
VLookups..

This is what a VLookup formula basically looks like:

=VLOOKUP(Cell / Value that you want to find, A matrix of data where it can find the value your searching for (Must be in the left hand column), Once found - Which column along that line you want to return the value of, FALSE or 0)

For Example:


=VLOOKUP(B3,E3:F7,2,0)

As an example for your question. Try this.
Place this is Sheet1, column M (Change the row number accordingly, I will use 1 for convenience.


=VLOOKUP(B1,Sheet2!$B$1:$F$20,2,0)

VLOOKUP = Function

B1 = The cell / value that we're searching for

Sheet2!$B$1:$F$20 = Look at Sheet2 (Look at ranges B1 to F20) - Column B, has the value that we're searching for - The dollar signs LOCKS the range, so that they don't change when you drag the formula downwards

2 = Return value from column 2 in the RANGE of CELLS... As we started at column B, then B = 1 , C = 2 etc

0 = This returns an EXACT match.

It will be a bit of a pain to get everything in place, but once it's there, your good to go.

If you find that your returning #N/A then you can stop this by adding "IFERROR(" infront of the VLOOKUP, and adding " ,"") " at the end of the formula.

I hope this helps. :)

blackie42
04-28-2014, 04:06 AM
Thanks for reply,

Just getting back to this after holidays. Can't seem to get my head round this.

I copied the formula in to colM on sheet1 but just keep getting N/A. Just to recap....

Sheet1 has a customer number in colB, sheet2 has the same customer number in colA (although in a different row)

What I want to do is copy the contents of the adjacent cells in sheet2 (colB,C,D,E) in to cols M,N,O&P in sheet1.

thanks for any more pointers

ashleyuk1984
04-28-2014, 05:39 AM
I see, I noticed in your first post that you mentioned column B on sheet 2.. but in your latest comment, the data is actually in column A of Sheet 2. This is why it's not working.

Try this code instead.


=VLOOKUP(B1,Sheet2!$A$1:$F$20,2,0)

See if you get anything back.
Other than that, upload your spreadsheet and it will be done in no time. :)

jolivanes
04-30-2014, 11:17 PM
I know it is marked as solved but I am ust curious why it would take hours and why it hangs.
Did you change this

Set fnd = sht2.Cells.Find(sht1.Cells(r, "B"), , , xlWhole)
to this?

Set fnd = sht2.Cells.Find(sht1.Cells(r, "A"), , , xlWhole)
and this

If Not fnd Is Nothing Then fnd.Offset(, 1).Resize(, 3).Copy sht1.Cells(r, 3)
to this?

If Not fnd Is Nothing Then fnd.Offset(, 1).Resize(, 4).Copy sht1.Cells(r, 13)

blackie42
05-13-2014, 07:33 AM
Just to recap

On sheet 1 in column B I have an account number. On sheet 2 in Col A there might be a match. If there is then I need to copy the contents of col B,C,D & E (same row) in to sheet 1 cols M,N,P & Q

The macro code I am using is as follows (it does work but after 15 minutes I interrupt it and its only completed about 500 out of 2612 entries on sheet1 - possible problem is there are 93000 rows to wade through on sheet 2


Sub Get_Offset_Values()
Dim sht1 As Worksheet, sht2 As Worksheet
Dim fnd As Range, LastRow As Long, r As Long

On Error Resume Next

Set sht2 = Sheets("Sheet2")
Set sht1 = Sheets("Sheet1")
LastRow = sht1.Cells(Rows.Count, "B").End(xlUp).Row
For r = 2 To LastRow 'change 2 to 1 if you don't have headers
Set fnd = Nothing
Set fnd = sht2.Cells.Find(sht1.Cells(r, "B"), , , xlWhole)
If Not fnd Is Nothing Then fnd.Offset(, 1).Resize(, 4).Copy sht1.Cells(r, 13)
Next r

End Sub

blackie42
05-13-2014, 07:56 AM
Hi

Got the VLOOKUP working on a smaller scale (test) - just need to do it with the full spreadsheets

thanks for all your help guys

regards

jolivanes
06-01-2017, 11:51 AM
You could try these in a copy of your workbook with the full compliments of data.
Array sizes are restricted by available memory so you could get the "Out Of Memory" warning.
It pastes the result in Sheet1, Columns B to F as it stands for now.

Sub With_Arrays()
Dim a, b, i As Long, j As Long, x As Long
Dim sh1 As Worksheet, sh2 As Worksheet
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
a = sh1.Range("B2:F" & sh1.Cells(Rows.Count, 2).End(xlUp).Row).Value
b = sh2.Range("A2:E" & sh2.Cells(Rows.Count, 1).End(xlUp).Row).Value
For i = LBound(a) To UBound(a)
For j = LBound(b) To UBound(b)
If b(j, 1) = a(i, 1) Then
For x = 2 To 5
a(i, x) = b(j, x)
Next x
Exit For
Else
End If
Next j
Next i
sh1.Range("B2").Resize(UBound(a), 5) = a
End Sub


Sub Get_Offset_Values()
Dim sht1 As Worksheet, sht2 As Worksheet
Dim fnd As Range, LastRow As Long, r As Long
Set sht2 = Sheets("Sheet2")
Set sht1 = Sheets("Sheet1")
LastRow = sht1.Cells(Rows.Count, "B").End(xlUp).Row
For r = 2 To LastRow 'change 2 to 1 if you don't have headers
Set fnd = Nothing
Set fnd = sht2.Range("A2:A" & sht2.Cells(Rows.Count, 1).End(xlUp).Row).Find(sht1.Cells(r, "B"), , , xlWhole)
If Not fnd Is Nothing Then fnd.Offset(, 1).Resize(, 4).Copy sht1.Cells(r, 3)
Next r
End Sub


The first one, with arrays, should be the fastest by far if it does work.

mdmackillop
06-01-2017, 12:22 PM
I hope after 3 years he's still not waiting for the code to finish.:devil2:

jolivanes
06-01-2017, 12:55 PM
Shoot. Don't know why I didn't see that. I just resurrected an excel file that was found somewhere on my computer.
Well, I hope he has it solved by now.
Thanks for waking me up mdmackillop.