create hyperlink on a column in excel sheet to open multilayered subfolder

I have folders and sub-folders like this 8 layers and 500K records in one sheet:

C:999236857871
C:999234567874
C:999234567873
C:999234586396
C:999234566458


In Test worksheet Column A has data

236857871
234567874
234567873
234586396
234566458


I wanted to create a macro to create a hyperlink on the existing data in Column A so that when I click on the data, the respective folder would open. I grafted a macro from one that was available in StackOverflow below. It creates only one destination...it could not create a link for respective records. Can I get help?

Sub HyperlinkNums ()
Dim WK As Workbooks
Dim sh As Worksheet
Dim i As Long
Dim lr As Long
Dim Rng As Range, Cell As Range
Set sh = Workbooks("Bigboss.xlsm").Sheets("Test")
lr = sh.Range("A" & sh.Rows.Count).End(xlUp).Row
Set Rng = sh.Range("A5:A" & lr)

sh.range("A5").Activate

For i = 7 To lr
For Each Cell In Rng

If Cell.Value > 1 Then

sh.Hyperlinks.Add Anchor:=Cell, Address:= _
"C:999" & Left(ActiveCell, 3) & "" & _
Mid(ActiveCell, 4, 3) & "" & Mid(ActiveCell, 7, 3) & "" & _
Right(ActiveCell, 3), TextToDisplay:=Cell.Value

End If


Next Cell
Next

End Sub.


1 Answer
1

So, the largest issue in your code is that you are always referring to the ActiveCell. You are using a For Each...Next loop, and you should be using the rng object that you are looping.

ActiveCell

For Each...Next

rng

You also have a redundant loop: For i = 7 To lr. You can get rid of this.

For i = 7 To lr

And I am not a big fan of using semi-reserved keywords as variables, so I slightly renamed the cell variable to cel. I think this may be what you are looking for:

cell

cel

Option Explicit

Sub HyperlinkNums()
Dim WK As Workbooks
Dim sh As Worksheet
Dim lr As Long
Dim Rng As Range, Cel As Range
Set sh = Workbooks("Bigboss.xlsm").Sheets("Test")
lr = sh.Range("A" & sh.Rows.Count).End(xlUp).Row
Set Rng = sh.Range("A5:A" & lr)

sh.Range("A5").Activate

For Each Cel In Rng

If Cel.Value > 1 Then

sh.Hyperlinks.Add Cel, "C:999" & Left(Cel.Text, 3) & "" & _
Mid(Cel.Text, 4, 3) & "" & Right(Cel.Text, 3), _
TextToDisplay:=Cel.Text

End If


Next Cel

End Sub


Also, I was slightly confused about the usage of Mid(ActiveCell, 7, 3), which it appeared to have the same meaning to Right(ActiveCell, 3). I removed that portion.

Mid(ActiveCell, 7, 3)

Right(ActiveCell, 3)

By clicking "Post Your Answer", you acknowledge that you have read our updated terms of service, privacy policy and cookie policy, and that your continued use of the website is subject to these policies.