VBA: Lookup Value Found in a Column within another Range and Copy Adjacent Values

redstarx

New Member
Joined
Jul 31, 2005
Messages
10
Hello,

I'm trying to create a macro that can lookup values down a list, find that value within another list and copy the adjacent cells.

The values to look for will always be on the same column and the values to look into will always be in the same range or columns but not always in the same row.

For example.

AI:AI contains a list of ID's which will be manually input every day so they might have a different order.

C:AF has all the data to look into. C always being a list of ID values and I want for every ID found on AI:AI to be search for on C:C: and then once a match is found, I need specific adjancent cell values to be copied next to the ID found on AI.

The values that need to be returned are found on columns B,D,F,G,H,I,J,P,AF and they will always display on those columns.

I've been doing this based on vlookup and INDEX/MATCh formulas but I've come across some limitations for something I want to develop further so I'm trying to do this based on VBA. I hope someone can help me.

I hope my explaination is clear enough but if more info is needed, let me know.

Thank you for your help.
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Try:
Code:
Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim rng As Range
    Dim foundVal As Range
    For Each rng In Range("AI2:AI" & LastRow)
        Set foundVal = Range("C2:C" & LastRow).Find(rng, LookIn:=xlValues, LookAt:=xlWhole)
        If Not foundVal Is Nothing Then
            Range("B" & foundVal.Row).Copy Range("AJ" & rng.Row)
            Range("D" & foundVal.Row).Copy Range("AK" & rng.Row)
            Range("F" & foundVal.Row & ":J" & foundVal.Row).Copy Range("AL" & rng.Row)
            Range("P" & foundVal.Row).Copy Range("AQ" & rng.Row)
            Range("AF" & foundVal.Row).Copy Range("AR" & rng.Row)
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Thank you very much, it did the trick but now I'm having an issue. Yesterday I tried and it worked but it only worked on one workbook. for some reason it doesn't want to do its thing on any other workbook even if it's formatted the same way as the one where it works.
 
Upvote 0
That's interesting. I don't know what the problem is. Could you upload one of the workbooks on which it doesn't work to a free site such as www.box.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here.
 
Upvote 0
Sorry I didn't reply before. I managed to get it to work. the problem was that I had another macro that kept running after used so I had to delete it. After that, it all works just as expected. Tank you so much for your help.
 
Upvote 0

Forum statistics

Threads
1,215,079
Messages
6,123,009
Members
449,093
Latest member
ikke

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
Back
Top