You are here:

- Home
- Computing/Technology
- Business Software
- Excel
- vloopkup VBA code

Advertisement

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.

Hello Saurabh,

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.

______________________________________

Sub FindRenamePics()

'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

End If

Next P

Next iRow

End Sub

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

End Function

____________________________________

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):

______________________________________

Sub PastePics()

'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")

With DestPicSheet

For iRow = 1 To .Range("A65536").End(xlUp).Row

PartNo = .Cells(iRow, "A").Text

PicName = "P_" & PartNo

If PicExists(PicName, SourcePicSheet.Name) Then

SourcePicSheet.Pictures(PicName).Copy

.Paste Destination:=.Cells(iRow, "B")

.Cells(iRow, "B") = "Picture inserted"

Else

.Cells(iRow, "B") = "No picture"

End If

Next iRow

End With

End Sub

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)

Else

Set Pic = Worksheets(EWSname).Shapes(P)

End If

PicExists = True

Exit Function

NoPic:

PicExists = False

End Function

______________________________________

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.

Some caveats:

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

Keep Excelling.

Damon

This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here

Excel

Answers by Expert:

I have extensive experience with VBA programming in Excel 5 through Excel 2013. As a former aerospace engineer with a large aerospace corporation and consultant in a small defense technology services company, I have developed a wide range of applications in VBA, including simulations involving mixed-language programming, satellite orbit mechanics, graphics and animation, and real-time applications. I am interested in moderate to hard VBA-related questions only.

I have developed and taught several courses in Excel VBA programming and also VBA programming in Office 97, 2000, and 2007. I have developed a number of large technical applications in Excel VBA for use within the aerospace industry.**Education/Credentials**

B.S. in Electrical Engineering and Computer Science, University of California, Berkeley.