Create hyperlinks by with using the link for each

[jcmckeon]

I have 200 or more hyperlinks to make to a network drive. If you do the traditional way, insert link etc, it takes WAAAAY to long. When I look at the url is it: \\str-file-01\Org Data\data\dept\Training\Employee Training Files\Balakier, Matthew\AS9100 - this was put in the traditional way it works.

But if I type exactly what's there it doesn't work. There is some "magic sauce" that I'm missing?

Ultimately I want to combine A2 B2 C2 D1 and have that appear as a clickable x See image. Whatever you can suggest would be AWESOME as I don't want to do 200+ of these.

 

[sijpie]

This sjhould do the trick. Read the comments, and act if necessary to the ones starting with <<<<

Option Explicit

Sub CreateHLink()
'

'
    Dim vIn As Variant
    Dim rOut As Range, rIn As Range
    Dim lR As Long
    Dim sURL As String
    
    Set rIn = Range("A1").CurrentArray  '<<<< Set to top left corner of your list
    
    'load list in array
    vIn = rIn.Value
    
    Set rOut = Range("D" & rIn.Cells(1, 1).Row + 1)     '<<<< column letter for hyperlink
    For lR = 2 To UBound(vIn, 1)    'skip header row
        
        'display hyperlink as 'X' but link behind is Ax & Bx & ", " & Cx & D1  (path & surname & ", " first name & & AS9100)
        rOut = "X"
        ActiveSheet.Hyperlinks.Add Anchor:=rOut, Address:=vIn(lR, 1) & vIn(lR, 2) & ", " & vIn(lR, 3) & vIn(1, 4)
    Next lR
End Sub

 

[jcmckeon]

This sjhould do the trick. Read the comments, and act if necessary to the ones starting with <<<<

Option Explicit

Sub CreateHLink()
'

'
    Dim vIn As Variant
    Dim rOut As Range, rIn As Range
    Dim lR As Long
    Dim sURL As String
   
    Set rIn = Range("A1").CurrentArray  '<<<< Set to top left corner of your list
   
    'load list in array
    vIn = rIn.Value
   
    Set rOut = Range("D" & rIn.Cells(1, 1).Row + 1)     '<<<< column letter for hyperlink
    For lR = 2 To UBound(vIn, 1)    'skip header row
       
        'display hyperlink as 'X' but link behind is Ax & Bx & ", " & Cx & D1  (path & surname & ", " first name & & AS9100)
        rOut = "X"
        ActiveSheet.Hyperlinks.Add Anchor:=rOut, Address:=vIn(lR, 1) & vIn(lR, 2) & ", " & vIn(lR, 3) & vIn(1, 4)
    Next lR
End Sub

wow I can't wait to give this a try. So put this into a vb module? I'll let you now. Thanks again for the help.

 

[sijpie]

Yes, press Alt-F8, type a dummy name, select New... press OK. The VBA editor will open . In the window select everything, delete. Then paste the code above.
Go back to Excel, press Alt-F8 again and double click on the macro name.

Make a backup copy of your sheet first!!

 

[jcmckeon]

Hi Sijpie, see the images attached. I ran debug and see what's in yellow. I included a shot of the spreadsheet.
I really really appreciate your help with this.

 

[sijpie]

I am away for a few days, will look at it later in the week or early next week

 

[sijpie]

Ah, costly typo...

Option Explicit

Sub CreateHLink()
'

'
    Dim vIn As Variant
    Dim rOut As Range, rIn As Range
    Dim lR As Long
    Dim sURL As String
    
    Set rIn = Range("A1").CurrentRegion  '<<<< Set to top left corner of your list
    
    'load list in array
    vIn = rIn.Value
    
    Set rOut = Range("D" & rIn.Cells(1, 1).Row + 1)     '<<<< column letter for hyperlink
    For lR = 2 To UBound(vIn, 1)    'skip header row
        
        'display hyperlink as 'X' but link behind is Ax & Bx & ", " & Cx & D1  (path & surname & ", " first name & & AS9100)
        rOut = "X"
        ActiveSheet.Hyperlinks.Add Anchor:=rOut, Address:=vIn(lR, 1) & vIn(lR, 2) & ", " & vIn(lR, 3) & vIn(1, 4)
    Next lR
End Sub

 

[jcmckeon]

Thank you so much. I really appreciate your help. Be well!