View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
PCLIVE PCLIVE is offline
external usenet poster
 
Posts: 1,311
Default Programmatically creating hyperlinks

Assuming your titles are in one column (column A beginning at row 1) and
there are no empty rows between titles:

For Each cell In Range("A1:A" & Range("A65536").End(xlUp).Row)
cell.Hyperlinks.Add Anchor:=Range("A" & cell.Row), Address:="",
SubAddress:= _
"'" & Sheets(cell.Value).Name & "'!A1",
TextToDisplay:=Sheets(cell.Value).Name
Next cell

HTH,
Paul
--

"Wannabe" wrote in message
...
I have one worksheet that lists a bunch of titles. Then for each title in
the
first worksheet, I have another worksheet that corresponds to one of those
titles on the first worksheet. I could have up to 250 worksheets, one for
each title in the first worksheet. Can someone provide me with a way to
programmatically make the titles on the first sheet become hyperlinks that
point to its corresponding sheet in the workbook. Plus, this is a
dynamically
workbook. Each week, it will have different titles and corresponding
worksheets for each, so I need to be able to save this code for use each
week
when I create this workbook.

I've tried working on it myself, but am getting stuck on how to get to the
correct sheet for each title. My attempt is below if anyone needs a good
laugh :)

Any help will be greatly appreciated.

Code:
 Sub LinkSheets()
    Dim myRange As range
    Dim lastCell As Object
    Dim lastLoop As Boolean
    Dim sheetNumber As Integer

    'find the last cell so we know when to stop.
    With ActiveSheet
        Set lastCell = .Cells(.Rows.Count, "A").End(xlUp)
    End With

    'Select the row in the first worksheet that I want.
    range("A:A").Select

    For Each cell In Selection
        If lastLoop Then
            Exit For
        Else
            If cell.Value = lastCell Then
                lastLoop = True
            End If

            'Make sure I am not trying to link the worksheet header to
 another worksheet.
            'All good titles will have a dash.
            If InStr(1, cell.Value, "-")  0 Then
                Cells.Find(What:=cell.Value, After:=ActiveCell,
 LookIn:=xlValues, _
                    LookAt:=xlPart, SearchOrder:=xlByColumns,
 SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False).Activate

                Dim workSheetCount As Integer
                Dim x As Integer
                workSheetCount = ActiveWorkbook.Worksheets.Count

                'Get stuck here trying to go to the next sheet and search
 for my title
                'to see if this is the corresponding sheet I need for this
 title.
                For x = 1 To workSheetCount
                    ActiveWorkbook.Sheets(x).Select
                    Cells.FindNext(After:=ActiveCell).Activate
                Next

                'Once I do find the correct sheet, I hope this will create
 the hyperlink I want
                ActiveSheet.Hyperlinks.Add Anchor:=cell, _
                    Address:="", SubAddress:=ActiveCell.Address,
 TextToDisplay:=cell.Value

                'Then I want to create a "back" hyperlink to take the user
 back to the
                'master page (first page).
            End If
        End If
    Next cell
 End Sub