Manage all Hyperlinks in Workbook from new Worksheet

[blis]

Hello masters of VBA I am new to vba and asking for help.
I have a macro. It insert new list "SeznamHyperlink" and
- lists all hyperlinks from workbook in column A,
- for each hyperlink it returns address of hyperlink (sheetname!cellname) in column B,
- for each hyperlink it returns "friendly_name" in column C,
- for each hyperlink it returns "link_location" in column D and
- for each hyperlink it inset hyperlink function =hyperlink(columnD, columnC)

Here is the macro
[vba]

Sub KopirajHyperlink()
Dim ws As Worksheet
Dim h_link As Long

On Error Resume Next
Application.DisplayAlerts = False
Sheets("SeznamHyperlink").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Sheets.Add().Name = "SeznamHyperlink"
For Each ws In Worksheets
If ws.Name <> "SeznamHyperlink" Then
For h_link = 1 To ws.UsedRange.Hyperlinks.Count
ws.Hyperlinks(h_link).Range.Copy
With Sheets("SeznamHyperlink").Cells(Rows.Count, 1).End(xlUp)
.Offset(1, 0).PasteSpecial
.Offset(1, 1) = ws.Hyperlinks(h_link).Range.Worksheet.Name & "!" & ws.Hyperlinks(h_link).Range.Address
.Offset(1, 2) = ws.Hyperlinks(h_link).Name
If ws.Hyperlinks(h_link).Address <> "" Then
.Offset(1, 3) = ws.Hyperlinks(h_link).Address
Else
.Offset(1, 3) = "#" & ws.Hyperlinks(h_link).SubAddress
End If
.Offset(1, 4) = "=Hyperlink(RC[-1], RC[-2])"
End With
Application.CutCopyMode = False
Next h_link
End If
Next ws
End Sub

[/vba]

Now to my problem. I would like to replace every founded hyperlink in workbook with hypelink formula. Formula should get its arguments from inserted worksheet "SeznamHyperlink" - "link_location" from column D and "friendly_name" from column C.

Can this be done? Thanks in advance

[domfootwear]

Hello masters of VBA I am new to vba and asking for help.
I have a macro. It insert new list "SeznamHyperlink" and
- lists all hyperlinks from workbook in column A,
- for each hyperlink it returns address of hyperlink (sheetname!cellname) in column B,
- for each hyperlink it returns "friendly_name" in column C,
- for each hyperlink it returns "link_location" in column D and
- for each hyperlink it inset hyperlink function =hyperlink(columnD, columnC)

Here is the macro
[vba]

Sub KopirajHyperlink()
Dim ws As Worksheet
Dim h_link As Long

On Error Resume Next
Application.DisplayAlerts = False
Sheets("SeznamHyperlink").Delete
On Error GoTo 0
Application.DisplayAlerts = True
Sheets.Add().Name = "SeznamHyperlink"
For Each ws In Worksheets
If ws.Name <> "SeznamHyperlink" Then
For h_link = 1 To ws.UsedRange.Hyperlinks.Count
ws.Hyperlinks(h_link).Range.Copy
With Sheets("SeznamHyperlink").Cells(Rows.Count, 1).End(xlUp)
.Offset(1, 0).PasteSpecial
.Offset(1, 1) = ws.Hyperlinks(h_link).Range.Worksheet.Name & "!" & ws.Hyperlinks(h_link).Range.Address
.Offset(1, 2) = ws.Hyperlinks(h_link).Name
If ws.Hyperlinks(h_link).Address <> "" Then
.Offset(1, 3) = ws.Hyperlinks(h_link).Address
Else
.Offset(1, 3) = "#" & ws.Hyperlinks(h_link).SubAddress
End If
.Offset(1, 4) = "=Hyperlink(RC[-1], RC[-2])"
End With
Application.CutCopyMode = False
Next h_link
End If
Next ws
End Sub

[/vba]

Now to my problem. I would like to replace every founded hyperlink in workbook with hypelink formula. Formula should get its arguments from inserted worksheet "SeznamHyperlink" - "link_location" from column D and "friendly_name" from column C.

Can this be done? Thanks in advance

I don't understand your mean, but pls try this code:

Private Sub Worksheet_Activate()
Dim wSheet As Worksheet
Dim M As Long
M = 1
    With Me
       .Columns(1).ClearContents
       .Cells(1, 1) = "List of sheets"
       .Cells(1, 1).Name = "Index"
    End With
    For Each wSheet In Worksheets
        If wSheet.Name <> Me.Name Then
        M = M + 1
        With wSheet
            .Range("a1").Name = "Start" & wSheet.Index
            .Hyperlinks.Add Anchor:=.Range("A1"), Address:="", _
            SubAddress:="Index", TextToDisplay:="Back to Index"
        End With
            Me.Hyperlinks.Add Anchor:=Me.Cells(M, 1), Address:="", _
            SubAddress:="Start" & wSheet.Index, TextToDisplay:=wSheet.Name
        End If
    Next wSheet
End Sub

Pls see att. file
http://www.4shared.com/file/21870898...yper_link.html

[blis]

Hi domfootwear and thanks for helping.

let me explain myselft a bit more. For better understanding download workbook from

This workbook has several worksheets with multiple hyperlinks. Worksheet "SeznamHyperlink" is inserted with macro "kopirajHyperlink" (you can ran macro again and see for your selft). Macro copies all founded hyperlinks in a workbook to column A of inserted worksheet "SeznamHyperlink". It also returns address of hyperlink (sheetname!cellname) in column B, "friendly_name" in column C,"link_location" in column D and insets hyperlink function =hyperlink(columnD, columnC).

So macro lists all hyperlinks found. Now I am trying to change that macro so that it would replace each founded hyperlink with function hyperlink(). Arguments for hyperlink function should get form list "SeznamHyperlinks".

so, when i ran macro it finds first link in sheet "kazalo" cell E7. this hyperlink is copied to newly inserted worksheet "SeznamHyperlink" to column A (cell A2). then it fills apropriete data to column B (B2), C (C2), D (D2), E (E2). At this point i would like macro to replace this hiperlink found (sheet "Kazalo", cell "E7") with function "=hyperlink(SeznamHyperlink!D2, SeznamHyperlink!C2)". Next hyperlink is found in sheet "Kazalo", cell "E10" - macro should replace that hyperlink with function "=hyperlink(SeznamHyperlink!D3, SeznamHyperlink!C3) and soo on.

I hope you understand me. I know my english is far from perfect.

Thx for help.

[blis]

i cant post link to document because i dont have enough posts....

[blis]

still cant....

[blis]

i am close to have 5 posts, so i can post a link to workbook....

[lucas]

you can attach your file to your post. Select go advanced and then scroll down and look for a button that says, manage attachments.

[blis]

http://www.4shared.com/file/21915286...9/Katalog.html
link to workbook

[blis]

Hey lucas.

I tried that but i had some problems with that. I hope you are not mad for my workaround

Now back to my macro. The main idea of that macro is to manage all hyperlinks in workbook from one sheet (SeznamHyperlink). I have 10 workbooks with at least 50 sheets and mio hyperlink. I need to find a way to manage hyperlinks from one sheet.

[blis]

[VBA]
For Each ws In Worksheets
If ws.Name <> "SeznamHyperlink" Then
For h_link = 1 To ws.UsedRange.Hyperlinks.Count
ws.Hyperlinks(h_link).Range.Copy
With Sheets("SeznamHyperlink").Cells(Rows.Count, 1).End(xlUp)
.Offset(1, 0).PasteSpecial
.Offset(1, 1) = ws.Hyperlinks(h_link).Range.Worksheet.Name & "!" & ws.Hyperlinks(h_link).Range.Address
.Offset(1, 2) = ws.Hyperlinks(h_link).Name
If ws.Hyperlinks(h_link).Address <> "" Then
.Offset(1, 3) = ws.Hyperlinks(h_link).Address
Else
.Offset(1, 3) = "#" & ws.Hyperlinks(h_link).SubAddress
End If
.Offset(1, 4) = "=Hyperlink(RC[-1], RC[-2])"
End With

Here is the place to insert code...
i need to replace first founded hyperlink with formula
=hyperlink(SeznamHyperlink!D2, SeznamHyperlink!C2).
Second hyperlinks should be replaced with formula
which gets arguments from D3 and C3
(from sheet SeznamHyperlink)etc

Application.CutCopyMode = False
Next h_link
End If
Next ws
[/VBA]

Pls someone help me.