Hyperlinking multiple cells based on another cell's contents

[epd]

Hi,

I have just started to learn how to use vba in microsoft excel. Over the past few days i have been creating a drawing register and have incorporated multiple routines based on searching this forum. Up until this point i have foud everything i needed on this forum, but now i cannot work out how to creat a routine that does the below.

The setup
*I have a folder called Zircon Plant
*That folder contains 3 folders 01. Superseded, 02. PDFs and 03. Documentation (the 01. Sup...etc. is the actual folder name, the 01, 02 and 03 isnt distinguishing the 3 folders)
*The Register is located in 03. Documentation
*The PDFs i want to hyperlink to are located in 02. PDFs

What i want to do
*i have 2000 rows of drawing names
*the drawing name in excel is spread over 5 side by side cells on each row (rows 21 - 2020) so for example the first row the information is in cells (H21, I21, J21, K21 ,L21)
*the cells i want to contain hyperlinks are V21 - V2020

so what i want is when excel opens up (i already have another script running at startup so i will be placing this after the other startup routine i have) i want it to search in folder 02. PDFs using the contents in (for example the first row (21) and colums HIJKL contain (H21)4CP(I21)-(J21)D(K21)-(L21)55000) each row and combine those cell contents to find the file name 4CP-D-55000.pdf. I then want it to go down every row until row 2020 untill it has added all pdfs.

(The second row is (H22)4CP(I221)-(J221)D(K221)-(L21)55001.....file name would be 4CP-D-55001.....third row would be 4CP-D-55002 etc...)

If such a pdf with that name doesnt exist, i want the cell (for example v21) to read "PDF not available"

based on a search here i have been able to do this for 1 cell, but dont want to do 2000 seperate routines. the current routine i have for it to work on one cell is




[VBA]
' Select PDF range
ActiveSheet.Range("u21").Select

' Promt PDF Hyperlinking
ActiveCell.Hyperlinks.Add ActiveCell, "I:\Drafting\As Built\4CP - Pinkenba\E - Electrical\Zircon Plant\02. PDFs\4CP-D-55000.pdf"[/VBA]




I also have multiple sheets. the first sheet is D - Documentation. I will eventually copy this routine 4 more times as i will be able to work out how to apply it to the other sheets, but for now i just need help doing it for the first sheet.

Your help would be greatly appreciated. If more information is needed please dont hesitate to ask.

[p45cal]

Something along these lines working on the active sheet:
[VBA]Sub blah()
Set fs = CreateObject("Scripting.FileSystemObject")
For Each cll In Range("V21:V2020").Cells
fname = "I:\Drafting\As Built\4CP - Pinkenba\E - Electrical\Zircon Plant\02. PDFs\"
For Each cel In Cells(cll.Row, "H").Resize(, 5).Cells
fname = fname & cel.Value
Next cel
fname = fname & ".pdf"
If fs.FileExists(fname) Then
cll.parent.Hyperlinks.Add cll, fname
Else
cll.Value = "PDF not available"
End If
Next cll
End Sub
[/VBA]

[epd]

Thanks for replying p45cal.

I have added your code into my routine

[vba]Sub auto_Open()

'Promt
UserForm2.Show

'Run PDF hyperlinking
Set fs = CreateObject("Scripting.FileSystemObject")
For Each cll In Range("V21:V2020").Cells
fname = "I:\Drafting\As Built\4CP - Pinkenba\E - Electrical\Zircon Plant\02. PDFs\"
For Each cel In Cells(cll.Row, "H").Resize(, 5).Cells
fname = fname & cel.Value
Next cel
fname = fname & ".pdf"
If fs.FileExists(fname) Then
cll.Hyperlinks.Add cll, fname
Else
cll.Value = "PDF not available"
End If
Next cll

End Sub[/vba]

when i open the worksheet your script runs and thinks for a while, but doesnt seem to do anything. also how do i script so im telling excel to use the combination in cells for example h21,i21,j21,k21,l21 to find the .pdf filename?

also copying the script is all well and good but im trying to get my head around what you have actually done in your script. what is it that the script is telling excel to do?

thanks again for your help

[epd]

also how do i script so im telling excel to use the combination in cells for example h21,i21,j21,k21,l21 to find the .pdf filename?

ok, your

[vba]For Each cel In Cells(cll.Row, "H").Resize(, 5).Cells[/vba]

script is the bit of code telling to look in those cells. i have just realized that. i wasnt aware that you could tell it to look at cells in this way.

also, i dont know if it matters what version i am using but i am using excel '07

[p45cal]

When developing, it's a good idea to take things one step at a time. That can be literal in that I recommend running the code first as a standalone macro and by using F8 on the keyboard to step through the code, line by line. This is to check that it works and to understand what it's doing.
Remember, I said that it worked on the active sheet, so you must make sure that that sheet is active before it runs. Now you have put this in the auto_opensub so it runs almost straight away as the file opens - let's hope the file was saved with the right sheet active! (There are, of course, ways to tweak the code to make sure it works on the right sheet.)
While you're stepping through the code there's a couple of panes that you can bring up:
The Local pane, View|Locals Window
The Immediate Pane Ctrl+G
In the Locals pane you can click to expand objects as well as seeing their values.
In the Immediate pane, you can put some commands in which will immediately be executed. For example, once you've got into the first For Each loop, you could try:
Cll.select
press Enter then have a look at what is selected on the worksheet. That tells you what the code is looking at.
You could do the likes of:
?fname
which will write out the value of fname at the time.
Some things you might want to try there when the code is being stepped through are:
cel.select
Cells(Cll.Row, "H").Resize(, 5).select

The code already uses the combination of those 5 cels to form a file name and path (there's a clue there to where).

Xl2007 should be fine.

ps. also note that I edited the code after posting and
cll.Hyperlinks.Add
should strictly be:
cll.Parent.Hyperlinks.Add

[epd]

great! thanks for your help mate. i will runt he script as a stand alone and will do it line by line as well. i will report on how i went shortly.

[epd]

in order to have this run in an active sheet i have made a button in a cell so when you click on it, it runs a macro.

[vba]Sub Hyperlinking()
'Run PDF Hyperlinking
Set fs = CreateObject("Scripting.FileSystemObject")
For Each Cll In Range("V21:V2020").Cells
fname = "I:\Drafting\As Built\4CP - Pinkenba\E - Electrical\Zircon Plant\02. PDFs\"
For Each cel In Cells(Cll.Row, "H").Resize(, 5).Cells
fname = fname & cel.Value
Next cel
fname = fname & ".pdf"
If fs.FileExists(fname) Then
Cll.Parent.Hyperlinks.Add Cll, fname
Else
Cll.Value = "PDF not available"
End If
Next Cll
End Sub[/vba]

the cells in col V still wont hyperlink to a sheet. the computer thinks for a while but then nothing. have i done something wrong?

also, in some places the code has "cel" and other places it says "cll"

do they both mean cell?

[p45cal]

Does anything appear in column V?

Do you have something called TeamViewer? (Google it if not..)

[epd]

Does anything appear in column V?

Do you have something called TeamViewer? (Google it if not..)

Ah i have sorted it out. col v is actually grouped with col U. i changed it to say col u instead of v int he code and it now works.

Thanks for your help p45cal. It was much appreciated. It does what i want. i just need to changed the code so it puts the file name in col u as atm whether it is hyperlinked or not, the cell is populated with the phrase 'pdf not available'

[p45cal]

'atm' ?

Change:
Cll.Value = "PDF not available"
to:
Cll.Value = fname

[epd]

'atm' ?

Change:
Cll.Value = "PDF not available"
to:
Cll.Value = fname

atm = at the moment, sorry about that

this is what i have int he code now

[vba]Sub Hyperlinking()
'select cells and clear values so removed PDFs become unclickable
ActiveSheet.Range("U21:U2020").Select
Selection.ClearContents

'Run PDF Hyperlinking
Set fs = CreateObject("Scripting.FileSystemObject")
For Each Cll In Range("U21:U2020").Cells
fname = "I:\Drafting\As Built\4CP - Pinkenba\E - Electrical\Zircon Plant\02. PDFs\"
For Each cel In Cells(Cll.Row, "H").Resize(, 5).Cells
fname = fname & cel.Value
Next cel
fname = fname & ".pdf"

If fs.FileExists(fname) Then
Cll.Parent.Hyperlinks.Add Cll, fname
Else
Cll.Value = "PDF Unavailable"
End If
Next Cll
End Sub[/vba]

i added the " 'select cells and clear values so removed PDFs become unclickable" code as if a pdf was deleted, and this script ran again, the link to the pdf was deleted and it read PDF unavailable, but it was still an active hyperlink that linked to nothing. having the select all and clear contents go rid of that problem.

the only problem i have now is the "Cll.Parent.Hyperlinks.Add Cll, fname" shows the whole path in the cells that have found a respective PDF. Is it possible for the cell to be hyperlinked but have the file name as opposed to the whole path.

i have tried


[vba]If fs.FileExists(fname) Then
Cll.Parent.Hyperlinks.Add Cll, "PDF Available"
Else
Cll.Value = "PDF Unavailable"
End If[/vba]

but the hyperlinking doesnt work. it says it cant find the file when i click on it. i have also then tried to run a selection script after that, that then deletes the path in the cells so it keeps the file name but as soon as the contents of the cell is changed it wont link.

any thoughts?

[p45cal]

[vba]Sub Hyperlinking()
'select cells and clear values so removed PDFs become unclickable
ActiveSheet.Range("U21:U2020").Select
Selection.ClearContents

'Run PDF Hyperlinking
Set fs = CreateObject("Scripting.FileSystemObject")
For Each Cll In Range("U21:U2020").Cells
fname = "I:\Drafting\As Built\4CP - Pinkenba\E - Electrical\Zircon Plant\02. PDFs\"
shortname = ""
For Each cel In Cells(Cll.Row, "H").Resize(, 5).Cells
fname = fname & cel.Value
shortname = shortname & cel.Value
Next cel
fname = fname & ".pdf"
shortname = shortname & ".pdf"

If fs.FileExists(fname) Then
Cll.Parent.Hyperlinks.Add Cll, fname, , , shortname
Else
Cll.Value = "PDF Unavailable"
End If
Next Cll
End Sub
[/vba]

[epd]

[vba]Sub Hyperlinking()
'select cells and clear values so removed PDFs become unclickable
ActiveSheet.Range("U21:U2020").Select
Selection.ClearContents

'Run PDF Hyperlinking
Set fs = CreateObject("Scripting.FileSystemObject")
For Each Cll In Range("U21:U2020").Cells
fname = "I:\Drafting\As Built\4CP - Pinkenba\E - Electrical\Zircon Plant\02. PDFs\"
shortname = ""
For Each cel In Cells(Cll.Row, "H").Resize(, 5).Cells
fname = fname & cel.Value
shortname = shortname & cel.Value
Next cel
fname = fname & ".pdf"
shortname = shortname & ".pdf"

If fs.FileExists(fname) Then
Cll.Parent.Hyperlinks.Add Cll, fname, , , shortname
Else
Cll.Value = "PDF Unavailable"
End If
Next Cll
End Sub
[/vba]

amazing, thanks for that mate. appreciate your help.

This is the final code i have used

[VBA]Sub Hyperlinking()
'select cells and clear values so removed PDFs become unclickable
ActiveSheet.Range("U21:U2020").Select
Selection.ClearContents

'Run PDF Hyperlinking
Set fs = CreateObject("Scripting.FileSystemObject")
For Each Cll In Range("U21:U2020").Cells
fname = "I:\Drafting\As Built\4CP - Pinkenba\E - Electrical\Zircon Plant\02. PDFs\"
shortname = ""
For Each cel In Cells(Cll.Row, "H").Resize(, 5).Cells
fname = fname & cel.Value
shortname = shortname & cel.Value
Next cel
fname = fname & ".pdf"
shortname = shortname & ".pdf"

If fs.FileExists(fname) Then
Cll.Parent.Hyperlinks.Add Cll, fname, , , shortname
Else
Cll.Value = "PDF not Created"
End If
Next Cll

'select cells and make all text black, underlined and "Calibri" text style
ActiveSheet.Range("U21:U2020").Select
Selection.Font.ColorIndex = 3
Selection.Font.Underline = xlUnderlineStyleSingle
Selection.Font.Name = "Calibri"

End Sub[/VBA]