Excel/vloopkup VBA code
I have a list of part numbers in sheet 1 column A and corresponding photos for each part number in column F. Now I have a list of part numbers in sheet 2 and I want to apply Vlookup funtion in sheet2 and if that part number exist in sheet 2 photo of that part should come in sheet 2 column B. Please help me by telling how can I do this.
Here is the solution I promised yesterday. The way it gets around the VLOOKUP is by naming each picture a name with the part number embedded in it, in this case simply a string that is the serial number with "P_" prefixed. Because it directly references each picture it should be very fast no matter how many part numbers and pictures you have.
In order to name the pictures, which could be a tedious process manually (especially if you have a really lot of them) I wrote a macro to do this for you. The macro is FindRenamePics and it has a helper function PicInCell. Paste this macro code in a standard macro module of your workbook.
'loops through part numbers in column A and renames any picture it finds
'in the same row of column F with the part number prefixed with "P_".
Dim P As Shape 'a picture
Dim iRow As Long
For iRow = 1 To Range("A65536").End(xlUp).Row
'now loop through all pictures to see if any reside in column F of iRow
For Each P In ActiveSheet.Shapes
If PicInCell(P, Cells(iRow, "F")) Then
P.Name = "P_" & Cells(iRow, "A").Text
Function PicInCell(P As Shape, C As Range) As Boolean
'Yields TRUE if picture P resides in cell C
PicInCell = False
If P.Top < C.Top Then Exit Function
If P.Top > C.Top + C.Height Then Exit Function
If P.Left < C.Left Then Exit Function
If P.Left > C.Left + C.Width Then Exit Function
PicInCell = True
Activate Sheet1, then run FindRenamePics. This should properly name all the pictures. To verify a picture name simply select the picture and view the name in the Name box just above cell A1.
If you find a picture hasn't been renamed by this macro it is because the picture doesn't actually reside in the appropriate row in column F or isn't actually in column F. The picture must reside "in" the cell, which means its top left corner must lie within or on the boundary of the cell. Even one pixel outside will cause the routine to consider it to lie in a different cell, and fail to name it. If you get an error it is probably because two pictures lie in the same cell due to this issue, and is trying to give two pictures the same name, which it can't.
Okay, now you are ready to use the lookup code. Also paste this code in a standard macro module (can add it to the same module as before):
'Reads part numbers in Sheet1 col A, and gets corresponding picture for each in
'Sheet2 (if picture exists) and pastes it in column B next to part number cell.
'Note: does not size picture to fit in cell, nor expand cell to fit picture.
'Picture will be placed with its top left corner at top left corner of cell.
Dim iRow As Long
Dim PartNo As String
Dim PicName As String
Dim NewPicName As String
Dim DestPicSheet As Worksheet
Dim SourcePicSheet As Worksheet
Set SourcePicSheet = Worksheets("Sheet1")
Set DestPicSheet = Worksheets("Sheet2")
For iRow = 1 To .Range("A65536").End(xlUp).Row
PartNo = .Cells(iRow, "A").Text
PicName = "P_" & PartNo
If PicExists(PicName, SourcePicSheet.Name) Then
.Paste Destination:=.Cells(iRow, "B")
.Cells(iRow, "B") = "Picture inserted"
.Cells(iRow, "B") = "No picture"
Function PicExists(P As String, Optional EWSname As Variant) As Boolean
'Return true if P references an existing shape embedded in worksheet EWS
Dim Pic As Shape
On Error GoTo NoPic
If IsMissing(EWSname) Then
Set Pic = ActiveSheet.Shapes(P)
Set Pic = Worksheets(EWSname).Shapes(P)
PicExists = True
PicExists = False
Again there is a helper function PicExists.
Simply run the macro PastePics to insert all the pictures in column B next to the corresponding part numbers in column A.
I have assumed the pictures are already sized appropriately to fit in the cells. If not code would need to be added to either resize the pictures, or resize the width of column B or the row heights in Sheet2 to correspond to the picture width and height.
I have assumed your part numbers are no more than 38 characters long, and contain no punctuation or spaces. If this assumption is not correct the code will need to be modified.
I have not incorporated any error handling to make the routines "bulletproof". Hopefully, if you encounter any problems that require adding error handling you can see how to incorporate it yourself, but if not feel free to follow up.
Good luck. Let me know if you have any problems, and