0

I'm trying to loop through some sheets in a workbook to update hyperlink in column A but I keep encountering various issues I'm not able to understand.

Private Sub Workbook_Open()

    Dim HL As Hyperlink
    Dim lnk As String 'actual link
    Dim ori As String 'old link
    Dim nvr As String
    Dim forn As String 'hyperlink name
    Dim ws As Worksheet

    nvr = ThisWorkbook.Path 'new path
    ori = Sheets("check list e parametri").Range("a28").Value 'old path

    For Each ws In ThisWorkbook.Worksheets
        Select Case ws.Name
            Case "Fatture consegnate 2019", "Progress", "check list e parametri", "Fatture consegnate backup" 'sheets to skip
            Case Else
                With ActiveWorksheet
                .Range("a2:a200").Select
                    For Each HL In Selection.Hyperlinks
                        forn = HL.TextToDisplay
                        lnk = HL.Address 'complete link
                        lnk = Replace(lnk, ori, nvr) 'replace old path with new path
                        ActiveSheet.Hyperlinks.Add Anchor:=HL.Range, Address:=lnk, TextToDisplay:=forn 'new hyperlink with name
                    Next HL
                End With
            End Select
    Next ws

    Sheets("check list e parametri").Range("a28") = nvr 'new path saved for the future

End Sub

I'm pretty new to VBA so my knowledge is limited and my code is.. rude at least. I tried various looping alternatives, but the code continues to give me errors. I'm expecting the code to loop through all the non-excluded worksheets each time the workbook is open, identify the hyperlink in the selected range, replace the old path with the new and keep the same displayed name. (I'm using Excel 2013)

Pᴇʜ
  • 56,719
  • 10
  • 49
  • 73
Astyr
  • 19
  • 4
  • 2
    What kind of errors do you get? I can at least see that you are only changing hyperlinks on the activeworksheet. Shouldn't that be per worksheet? In that case you need to replace `ActiveSheet` and `ActiveWorksheet` with `ws`, since you use variable `ws` to loop through the sheets. – Alex de Jong Jun 24 '19 at 11:00
  • 6
    try with `With Ws.Range("a2:a200")` and `For Each HL In .Hyperlinks` – Ahmed AU Jun 24 '19 at 11:01
  • Keep getting Runtime Error 1004. I've also tried to substitute "with" with ws.range and selection.hyperlinks.. but it doesn't work. – Astyr Jun 24 '19 at 11:12
  • 2
    On which line do you get the error? – Alex de Jong Jun 24 '19 at 11:35
  • 1
    Additionally to AhmedAU's comment replace `ActiveSheet.Hyperlinks.Add` with `.Hyperlinks.Add`. • You might benefit from reading [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). – Pᴇʜ Jun 24 '19 at 11:48
  • It gives me that error on ".range("a2:a200").select. Thanks for the link, I'll dive into it. – Astyr Jun 24 '19 at 12:36

1 Answers1

1

And now it works! Thanks to all of you who pointed me in the right direction! The code looks like this:

Private Sub Workbook_Open()

Dim HL As Hyperlink
Dim lnk As String 'link attuale
Dim ori As String 'root vecchia
Dim nvr As String
Dim forn As String 'nome fornitore
Dim ws As Worksheet
Dim rng As Range

nvr = ThisWorkbook.Path 'nuova root
ori = Sheets("check list e parametri").Range("a28").Value 'vecchia root

For Each ws In ThisWorkbook.Worksheets
    Select Case ws.Name
        Case "Fatture consegnate 2019", "Progress", "check list e parametri", "Fatture consegnate backup"
        'salta questi fogli
        Case Else
            Set rng = ws.Range("a2:a200")
                For Each HL In rng.Hyperlinks 'check link
                    forn = HL.TextToDisplay
                    lnk = HL.Address 'link completo
                    lnk = Replace(lnk, ori, nvr)
                    ws.Hyperlinks.Add Anchor:=HL.Range, Address:=lnk, TextToDisplay:=forn 'nuovo hyperlink
                Next HL
    End Select
Next ws

Sheets("check list e parametri").Range("a28") = nvr 'sostituisce vecchia root con nuova


End Sub 

Again, thanks for the help!

David Podolak
  • 195
  • 2
  • 10
Astyr
  • 19
  • 4