VBA scan list of codes in A and return a different code based on match's in column S

Hi all,

First time using this forum, or any for that matter.
Apologies if I am doing this wrong or if this is in the wrong section, please advise if so and I can change.

Basically I have a ever expanding list of part numbers in in Column A, and I want to return a location code or likely many location codes in Column S.
I have compiled a list in my macro BaseDoc (macro enabled file which I run in the background to execute various macros on each delivery order).

So what I am looking for help with is creating a macro to scan the all populated cells in column A for code eg(1545214587) and if it is present to input (L1R6|L3R9|L2R1) into the corresponding cell in column S.
I have got it to work but only if I scan each cell in column A manually below is the code I used for that, however I now realize (after 2 weeks) that this will take many many lifetimes to input the same search for each cell in column A and then repeat over for the roughly 4000 part numbers one by one.
Below is an example of what I have been using. Can I loop this easily for any populated cells in column A?

Sub Part_Number_And_Location_Lookup()

If Range("A2").Value = 1545214587 Then Range("S2").Value = "L1R6|L3R9|L2R1"

End Sub

Any ideas on how I can test each cell in the column for the part number and return the value if it is present and just ignore it if not?
Or am I going about this task in completely the wrong way and is there a better way?

Thanks in advance
Brian.

Do you perchance have a list of part numbers with the data you want to enter? Code can be written to search for values that are in a list and populate the relative value. Please provide a sample file as per the yellow banner above that has both the lists and the parts you need updated.

Here is a sample list of the code lists, I will get a sample of the file I want to run the Macro on and upload as fast as possible

Thank you

Here is the sample of the sheets I will want to run the macro on, the layout as in the part number being in column A and the Location codes needing to be in column S will never change.
Thank you so much for any help you can offer

Brian

Can the list of codes be another sheet with in master list file?

Yea I don't see why not, my idea was to have them on a sheet within my BaseDoc as there is a massive list of codes (5000+) and it is ever expanding, also the locations change from time to time.
It will take me a long time to populate the list and it will have to be amended from time to time too, that is why I think it would be best to have a list of part numbers and corresponding location codes as although it will take a long time I can add to it bit by bit and change the locations if necessary.
Am I approaching the task wrong or is that the best way to achieve the goal?

Your approach sounds reasonable. I combined the two sample sheets into one file below, and the code applies to the file. If you need it to process faster there are some more things we can do. Test this for now.

Sub checkAndPop()
Dim cel, Rng As Range
Dim sh, lc As Worksheet
Dim i As Long
Dim ArrL()
Application.ScreenUpdating = False
Set sh = Sheets("sheet1")
Set lc = Sheets("ListCodes")

Set Rng = sh.Range("A2:A" & sh.Cells(Rows.Count, 1).End(xlUp).Row)

ArrL = lc.Range("A1:B" & lc.Cells(Rows.Count, 1).End(xlUp).Row)

For Each cel In Rng
    For i = LBound(ArrL, 1) To UBound(ArrL, 1)
    If cel.Value = ArrL(i, 1) Then
        'MsgBox cel.Value & " ," & ArrL(i, 1) & ", " & ArrL(i, 2)
        cel.Offset(0, 18).Value = ArrL(i, 2)
    End If
    Next i
Next cel

Application.ScreenUpdating = True
End Sub

Oh sorry I misunderstood your question before.
No they will be separate as the destination sheet (where I need the location inputted into column S) is created every day.
Sorry

Here you go, The code will ask you to open a destination sheet. Let me know if you have questions.

Sub checkAndPop()
Dim cel, Rng As Range
Dim sh, lc As Worksheet
Dim OpenWB As Workbook
Dim FileToOpen As String
Dim i As Long
Dim ArrL() As Variant
Application.ScreenUpdating = False
Set sh = ThisWorkbook.Sheets("Sheet1")

FileToOpen = Application.GetOpenFilename(Title:="Select File to Open, Destination Sheet", _
            FileFilter:="Excel Files (*.xls*),*xls*")
If FileToOpen = "False" Then Exit Sub
Set OpenWB = Workbooks.Open(Filename:=FileToOpen, ReadOnly:=False)

Set lc = OpenWB.Sheets("Sheet1")

Set Rng = lc.Range("A2:A" & lc.Cells(Rows.Count, 1).End(xlUp).Row)

ArrL = sh.Range("A1:B" & sh.Cells(Rows.Count, 1).End(xlUp).Row).Value

For Each cel In Rng
    For i = LBound(ArrL, 1) To UBound(ArrL, 1)
        If cel.Value = ArrL(i, 1) Then
            cel.Offset(0, 18).Value = ArrL(i, 2)
        End If
    Next i
Next cel

Application.ScreenUpdating = True
End Sub

No need of vba.

1) Open both workbooks.
2) Enter Sheet1!S2 of Sample2.xlsx
=IFERROR(VLOOKUP(A2,[sample.xlsx]Sheet1!A:B,2,FALSE),"")
then copy down.
3) close Sample.xlsx then formula should automatically update the link with the full path.