Populating a Cell Using Value of Another Cell to Lookup the Desired Value

[LordDragon]

Greetings,


I need a little more help please.

In my workbook there is a list of all the parts for all our systems. It's called the "Master DataList". The list is very simple.
Column A = Part Number
Column B = Part Name
Column C = Image (if there is an image of the part available, this is a hyperlink to it, currently represented by an icon)

The Master DataList is organized alphabetically by the Part Number.

There are several other sheets in my workbook that basically break down the Master DataList into the individual systems. They are all arranged the same:
Column A = Yes/No (do we want this part or not for this order?)
Column B = Part Name
Column C = Part Number
Column D = Quantity (how many do we want to order)
Column E = Image (this column is currently hidden as there are no image links put here yet)

The things I want to be able to do are:

Have the Part Number field on each system page refer to the Master DataList, find that number and fill in the Part Name field. I want to do it using VBA.

If possible, copy the image link too.

I have tried several "Lookup" code samples that I have found both in this forumn and in others and nothing seems to be working.

I would appreciate some help.

[Bob Phillips]

Post a workbook that we can work with.

[LordDragon]

Here you go.

[Bob Phillips]

Couldn't test it, the worksheets are protected


Public Function CopyData()
Dim master As Worksheet
Dim arySheets As Variant
Dim ws As Variant
Dim lastrow As Long
Dim matchrow As Long
Dim i As Long

Set mast = Worksheets("Master Parts List")
arySheets = [{"General Use Items"}] ' add other sheets in a comma delimited list
For Each ws In arySheets

With Worksheets(ws)

.Unprotect "password" ' <<<<<<<<<<<<<<<<<<<<<<<

lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 2 To lastrow

matchrow = 0
On Error Resume Next
matchrow = Application.Match(.Cells(i, "C"), master.Columns("C"), 0)
On Error GoTo 0
If matchrow > 0 Then

.Cells(i, "B").Value = master.Cells(matchrow, "B").Value
.Add
.Hyperlinks.Add Anchor:=.Cells(i, "E"), _
Address:="", _
SubAddress:="'Master Parts List'!" & .Cells(matchrow, "E").Address(False, False), _
TextToDisplay:="'Master Parts List'!" & .Cells(matchrow, "E").Address(False, False)
End If
Next i

.Protect "password" ' <<<<<<<<<<<<<<<<<<<<<<<
End With
Next ws
End Function

[LordDragon]

I made some changes.



Public Function CopyData()
Dim wkShtMaster As Worksheet
Dim varSheets As Variant
Dim wkSht As Variant
Dim lngRow As Long
Dim lngMatch As Long
Dim lngIncrement As Long

Set wkShtMaster = Worksheets("Master DataList")
varSheets = [{"General Use Items"}] ' add other sheets in a comma delimited list
For Each wkSht In varSheets

With Worksheets(wkSht)


lngRow = .Cells(.Rows.Count, "A").End(xlUp).Row
For lngIncrement = 2 To lngRow

lngMatch = 0
On Error Resume Next
lngMatch = Application.Match(.Cells(lngIncrement, "C"), wkShtMaster.Columns("A"), 0)
On Error GoTo 0
If lngMatch > 0 Then

.Cells(lngIncrement, "B").Value = wkShtMaster.Cells(lngMatch, "B").Value
.Add
.Hyperlinks.Add Anchor:=.Cells(lngIncrement, "E"), Address:="", SubAddress:="'Master DataList'!" & .Cells(lngMatch, "C").Address(False, False), TextToDisplay:="'Master DataList'!" & .Cells(lngMatch, "C").Address(False, False)
End If
Next lngIncrement

End With
Next wkSht
End Function


I got a "debug" error at the ".Add" part.

[Bob Phillips]

Something seems to have gone missing in my original code. If you tell me the password I can test it properly.

[LordDragon]

There's no need for a password.

The code that sets the password is below.



For Each wkSheet In Worksheets
wkSheet.Protect "P@s0n", UserInterfaceOnly:=True
Next wkSheet


This code allows all code and formula driven activities to work, but blocks User activities.

The password is included in that code, in case you still need it, but you shouldn't.

[Bob Phillips]

Public Function CopyData()
Dim master As Worksheet
Dim shp As Shape
Dim arySheets As Variant
Dim ws As Variant
Dim lastrow As Long
Dim matchrow As Long
Dim i As Long

Set master = Worksheets("Master Parts List")
arySheets = [{"General Use Items"}] ' add other sheets in a comma delimited list
For Each ws In arySheets

With Worksheets(ws)

.Unprotect "P@s0n"

.Columns("E").Hidden = False

lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 2 To lastrow

matchrow = 0
On Error Resume Next
matchrow = Application.Match(.Cells(i, "C"), master.Columns("C"), 0)
On Error GoTo 0
If matchrow > 0 Then

.Cells(i, "B").Value = master.Cells(matchrow, "B").Value
Set shp = GetShape(master, .Cells(matchrow, "E"))
If Not shp Is Nothing Then
.Hyperlinks.Add Anchor:=.Cells(i, "E"), _
Address:=shp.Hyperlink.Address, _
SubAddress:="", _
TextToDisplay:=shp.Name
End If
End If
Next i

.Protect "P@s0n"
End With
Next ws
End Function

Private Function GetShape(ByRef sh As Worksheet, ByRef cell As Range) As Shape
Dim shp As Shape

With sh

For Each shp In .Shapes

If shp.TopLeftCell.Row = cell.Row And shp.TopLeftCell.Column = cell.Column Then

Set GetShape = shp
Exit Function
End If
Next shp
End With
End Function

[LordDragon]

xld,

Thanks for the help, it almost works.

It does update the Part Name field based on the Part Number entered. However, the Hyperlink image thing is not working quite right.

It does put the hyperlink into the cell (it's not letting me follow the link, but that could be due to the website security). But it does not put the little icon in the cell.

I don't really need the icon to show up in the cell. I would be fine with it simply saying a single word like "Image" or "Sample" or something too.

[LordDragon]

Ok. I figured out how to do that part easy enough. It's still not letting me follow the link, but like I said, that could be due to the website security.

Thanks for all the help.