Add Hyperlink to cell

[Divinedar]

I have the following code that works fine but I need to modify it to do two things but for two separate files.

What I need is explained in the attachments:





The code is at follows:

Private Sub Worksheet_Change(ByVal Target As Range)
'change "c:\tmp\" to whatever reference you need
'a cell, a public variable, a fixed string

If Target.Column = 7 Then
MakeHyperLink Target, "H:\Darlene.Sippio\Personel\Test Department"
End If
End Sub

Public Function MakeHyperLink(InRange As Range, _
ToFolder As String, _
Optional InSheet As Worksheet, _
Optional WithExt As String = "doc") As String
Dim rng As Range
Dim Filename As String
Dim Ext As String
'check to see if folder has trailing \
If Right(ToFolder, 1) <> "\" Then
Filename = ToFolder & "\"
Else
Filename = ToFolder
End If
'check to see if need ext
If WithExt <> "" Then
'check to see if ext has leading dot
If Left(WithExt, 1) <> "." Then
WithExt = "." & WithExt
End If

End If
'if not explicit sheet then assign active
If InSheet Is Nothing Then
Set InSheet = ActiveSheet
End If
'now for every cell in range
For Each rng In InRange
'does range have value
If rng <> "" Then
'make hyperlink to file
InSheet.Hyperlinks.Add Anchor:=rng, Address:= _
Filename & rng.Text & WithExt, TextToDisplay:=rng.Text
End If

Next

End Function

I need help as soon as I can get it so if anyone has any ideas please let me know.