Find, copy & paste

[blackie42]

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]

You could achieve the same result by just using VLookup

Do you know how to use VLookup?

[jolivanes]

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]

Thanks for your help guys - macro works fine. Not used Vlookup for a while but will give that a try too

regards

[ashleyuk1984]

If you require any help with the VLookup you know where we are

[blackie42]

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]

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]

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]

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]

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]

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]

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]

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]

I hope after 3 years he's still not waiting for the code to finish.

[jolivanes]

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.