Code that populates next cell with hyperlink based on worksheet name

[manc]

Hi there.

I've used a macro from within these here walls so that a user can open a template worksheet ("sheet2" for example), click on a button, and it asks what they would like to call the new sheet, and as if by magic (or vba), a new sheet is created based on the template with the name entered.

Is there a way that on "sheet1", when a user has clicked the button on "sheet2" and renamed their new worksheet, that the name of this worksheet appears in the next available cell in column A, with a hyperlink attached, so you can just click it and it takes you to it?

Your constructive comments would be appreciated, as always.

Regards
Manc

 

[manc]

Here's the code used thus far to create and rename worksheet. Could a few lines of code be added to incorporate the above request?



Sub Macro1()
Dim strActiveSheetName As String
Dim strNewSheetName As String

strActiveSheetName = ActiveSheet.Name

SuggestNewSheetName:

strNewSheetName = InputBox( _
"Enter new Destination for " & strActiveSheetName & ":", _
"Freight Rates")

'Exit the routine if the user has clicked the button or not made an entry.
If Len(strNewSheetName) = 0 Then
Exit Sub
Else
'Check if the potential new sheet name already exists in the current workbook.
On Error GoTo CreateNewSheetName
If Len(ThisWorkbook.Sheets(strNewSheetName).Name) > 0 Then
If MsgBox(strNewSheetName & " already exists. Try again?", vbExclamation + vbYesNo, "Active Sheet Copy Editor") = vbYes Then
GoTo SuggestNewSheetName
Else
Exit Sub
End If
End If
End If

CreateNewSheetName:

Sheets(strActiveSheetName).Copy after:=Sheets(strActiveSheetName)
ActiveSheet.Name = strNewSheetName

End Sub




Regards
Manc

 

[AlphaFrog]

Try something like this...

Sheets("Sheet1").Hyperlinks.Add Anchor:=Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1), _
                    Address:="", SubAddress:=strNewSheetName & "!A1", TextToDisplay:=strNewSheetName

 

[manc]

Dear AlphaFrog

Thanks very much for your knowledge. Works perfect! Thanks again.

Regards
Manc