CODEWITHSUNDEEP
excelvba
user4907546
user4907546

Reputation: 121

Make active cell a hyperlink to newly created tab

Ok, so I am trying to make a macro that will allow users to hit the button, type their name into the input box, copy a worksheet template, move that new worksheet to the end of the book, rename it to match their name, and update the index sheet with a hyperlink showing their name on the list that jumps them to cell A4 on their sheet. The hyperlink part is where I'm struggling, although I also need some error handling for the rest of it. I have tried a variety of solutions, but I can't make it work for me. 

Sub CopyIIDTemplate()

    Dim MySheetName As String



    MySheetName = InputBox("Please type your first and last names.")

    Sheets("Template").Copy after:=Sheets("Template")

    ActiveSheet.Name = MySheetName

    ActiveSheet.Range("B1") = MySheetName

    ActiveSheet.Move after:=Worksheets(Worksheets.Count)

    Sheets("Index").Activate

    Sheets("Index").Range("B51").End(xlUp).Offset(1).Activate

    ActiveCell = MySheetName

    Sheets("Index").Hyperlinks.Add anchor:=Excel.Selection, Address:=ActiveCell.Value, SubAddress:="'" & Sheets("Index").ActiveCell.Text & "'!A4"



End Sub

Upvotes: 0

Views: 961

Answers (2)

YowE3K
YowE3K

Reputation: 23974

When creating hyperlinks, the Address parameter should be blank for a location within the existing workbook, and the SubAddress parameter can be created using your MySheetName variable rather than the invalid Sheets("Index").ActiveCell.Text (invalid because the ActiveCell is the active cell - it's not a property of a Worksheet object).

A refactored version of your code would be:

Sub CopyIIDTemplate()
    Dim MySheetName As String
    MySheetName = InputBox("Please type your first and last names.")

    'Make a copy of the "Template" sheet and place it after the last worksheet
    Worksheets("Template").Copy After:=Worksheets(Worksheets.Count)

    'Use a "With" block to make typing easier (i.e. we can use
    '".xxx" instead of "Worksheets(Worksheets.Count).xxx" everywhere
    'within the block
    '
    'Worksheets.Count gives the number of worksheets in the workbook.
    'Worksheets(Worksheets.Count) therefore gives the last worksheet
    'in the workbook, which is where we placed the copy of "Template".
    With Worksheets(Worksheets.Count)
        'Set this sheet's name
        .Name = MySheetName
        'Set cell B1's value to be the person's name
        .Range("B1").Value = MySheetName
    End With

    'Use another "With" block to save typing.  This time we are
    'using the cell one row below the last non-empty cell above cell
    'B51 on the worksheet called "Index".
    '
    'Note: Using Range("B" & Worksheets("Index").Rows.Count) instead of
    'Range("B51") may be better - that would find the last non-empty cell
    'in the entire column B.
    '
    With Worksheets("Index").Range("B51").End(xlUp).Offset(1)
        'Set the cell's value to be the person's name
        .Value = MySheetName

        'Add the hyperlink
        '
        'Anchor (i.e. where to place the hyperlink):
        '".Cells(1,1)" when applied to a range will give the top-left
        'corner of the range.  The range that we are applying it to is
        'a single cell, so this will simply point to that same cell.
        'It would have been nice to be able to just say "." to point to
        'the cell, but that would undoubtedly not work.
        '
        'Address (i.e. file/url to refer to):
        'Just use "" for a reference to the existing workbook
        '
        'SubAddress (i.e. location within the Address):
        'Need to create an address similar to "'Ian'!A4"
        'Wrap the person's name in "'" characters, so that embedded
        'spaces don't cause issues, and then stick a "!A4" at the end.
        '
        'Note: If the person's name contains any "'" characters (e.g.
        '"Antonio D'amore") the simplified version used here won't work
        'because "'Antonio D'amore'!A4" actually needs to be
        '"'Antonio D''amore'!A4", but let's ignore that for now.
        '
        .Hyperlinks.Add Anchor:=.Cells(1, 1), _
                        Address:="", _
                        SubAddress:="'" & mySheetName & "'!A4"
    End With
End Sub

Note: If any of your staff have a ' in their name, the subaddress parameter will need to be SubAddress:="'" & Replace(mySheetName, "'", "''") & "'!A4".

Upvotes: 1

Rufus
Rufus

Reputation: 378

There is incorrect reference in the last line:

Sheets("Index").Hyperlinks.Add anchor:=Excel.Selection, Address:=ActiveCell.Value, SubAddress:="'" & Sheets("Index").ActiveCell.Text & "'!A4"

Replace Sheets("Index").ActiveCell with ActiveCell and it should work.

Upvotes: 0

Related Questions