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

Question

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

C:\999\236\857\871 
C:\999\234\567\874 
C:\999\234\567\873 
C:\999\234\586\396 
C:\999\234\566\458

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.

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.

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

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:

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.