VBA - Hyperlinks.add - place in this document

[Marty Plante]

I have code that creates via copy & paste a range of cells for manual data entry. For navigation I add the title of this range to the bottom of a table. In trying to automate the final step - creating a hyperlink to the new range - I have been unable to find a solution.
I'll try to draw this out better:

Sheet 1: Contains an excel table where I have hyperlinks to various cells on other sheets.
Sheet 2: Contains a template approximately 40 rows by 10 columns at the top left of the sheet, and each time I create a new table it is copied and pasted to the bottom, below the last entry with a few blank rows left between the last.

Macro contains an input box where I enter a title in the top left cell.

Currently the code finishes with Sheet 1 (Navigation table) active, adding a new row to the bottom of the table, and with the cell active where I begin the manual steps to create a hyperlink to the new range on Sheet 2.

I would like to auto generate the hyperlink in the table to the new table on Sheet 2. It doesn't seem to be a complex problem, I just haven't found the right steps in VBA to complete the task.

Note: There is much more to this workbook than these two sheets, and the table for Navigation allows the sorting necessary to locate specific items quickly. This particular macro is specific to a particular page so I have left the full scope of the workbook out.

 

[GWteB]

Macro contains an input box where I enter a title in the top left cell.

If it's the top left cell of your newly added table, you could store its reference in a range variable, so its properties can be used to add a hyperlink at the bottom of your navigation table on Sheet1.
If you're willing to provide the code you are referring to in your post, it's much more easy to add appropriate code to implement what you are asking for.

 

[Marty Plante]

If it's the top left cell of your newly added table, you could store its reference in a range variable, so its properties can be used to add a hyperlink at the bottom of your navigation table on Sheet1.
If you're willing to provide the code you are referring to in your post, it's much more easy to add appropriate code to implement what you are asking for.

If it's the top left cell of your newly added table, you could store its reference in a range variable, so its properties can be used to add a hyperlink at the bottom of your navigation table on Sheet1.
If you're willing to provide the code you are referring to in your post, it's much more easy to add appropriate code to implement what you are asking for.

You will find this on the amateur side, for sure. Sheet 18 is where the copy/paste new table activity happens, Sheet 9 is where the Navigation table is. I have some code at the bottom you will see was not running but I have no idea if I was on the right track. The section copied is a named range.

Public Sub Add_New_Meal()

Sheet18.Select
'Macro won't run if Menu_Nutrition sheet isn't active, this ensures going to that page.

'Copy the meal template at the top left (second range down)of worksheet and paste it to the bottom of row A.
Dim myValue As Variant
myValue = InputBox("Enter name for new meal or ingredient list")
Range("A1").Value = myValue
'Uses an input box to enter a name into cell A1
If myValue = "" Then
Exit Sub
End If

Application.Goto Reference:="Meal_Nutrition_Range"
Selection.Copy

Dim LastRow As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & LastRow + 3).Select

ActiveSheet.Paste

Application.CutCopyMode = False
'That completes the copy paste process for the named range template

Range("A1:C1").Select
Selection.Copy
'selects and copies the new name from cell A1

LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & LastRow - 40).Select
'locates the name area in the new table, lowest table in the left columns

Selection.PasteSpecial Paste:=xlPasteValues
'Pasts the text only so that formatting of template can occur in the future

Range("A1:C1").Select
Selection.Copy
'selects and copies the new name from cell A1

Sheet9.Select

Dim NewRw As ListRow
Set NewRw = Sheet9.ListObjects("Tbl_Navigation_Links").ListRows.Add(AlwaysInsert:=True)
NewRw.Range(1, 7).Value = "Create your new meal hyperlink"

'ActiveCell.Hyperlinks.Add
'Worksheets("Navigate").Select


'Selection.PasteSpecial Paste:=xlPasteValues

'Application.CutCopyMode = False

End Sub

 

[GWteB]

See how far you can get with this. Adjustments are always possible, just let me know.

Public Sub Add_New_Meal()

    Dim myValue As String
    Dim NewRw   As ListRow
    Dim rng     As Range
    Dim arr     As Variant

    'Copy the meal template at the top left (second range down)of worksheet and paste it to the bottom of row A.
    myValue = InputBox("Enter name for new meal or ingredient list")

    If Len(myValue) > 0 Then
        With Sheet18
            .Range("A1").Value = myValue
            ' Uses an input box to enter a name into cell A1
            Set rng = .Cells(.Rows.Count, "A").End(xlUp).Offset(3, 0)
            ' determine top left location for new meal matrix
            .Range("Meal_Nutrition_Range").Copy Destination:=rng
            ' copies meal template to top left location for new meal matrix
            arr = .Range("A1:C1")
            ' copies the new name from cell A1
            rng.Resize(1, 3).Value = arr
            ' Pasts the text only so that formatting of template can occur in the future
        End With

        With Sheet9
            Set NewRw = .ListObjects("Tbl_Navigation_Links").ListRows.Add(AlwaysInsert:=True)
            ' adds a new row to the navigation table
            With .Hyperlinks.Add(NewRw.Range(1, 7), "")
                ' adds a hyperlink in the newly added row of the table, in the 7th column
                .SubAddress = rng.Parent.Name & "!" & rng.Resize(40, 10).Address
                ' subaddress property equals location within document associated with the hyperlink
                .ScreenTip = "Yet another tasteful meal at [" & .SubAddress & "]"
                ' whenever mouse hovers over ...
                .TextToDisplay = myValue
            End With
        End With
    End If
End Sub

 

[Marty Plante]

See how far you can get with this. Adjustments are always possible, just let me know.

Public Sub Add_New_Meal()

    Dim myValue As String
    Dim NewRw   As ListRow
    Dim rng     As Range
    Dim arr     As Variant

    'Copy the meal template at the top left (second range down)of worksheet and paste it to the bottom of row A.
    myValue = InputBox("Enter name for new meal or ingredient list")

    If Len(myValue) > 0 Then
        With Sheet18
            .Range("A1").Value = myValue
            ' Uses an input box to enter a name into cell A1
            Set rng = .Cells(.Rows.Count, "A").End(xlUp).Offset(3, 0)
            ' determine top left location for new meal matrix
            .Range("Meal_Nutrition_Range").Copy Destination:=rng
            ' copies meal template to top left location for new meal matrix
            arr = .Range("A1:C1")
            ' copies the new name from cell A1
            rng.Resize(1, 3).Value = arr
            ' Pasts the text only so that formatting of template can occur in the future
        End With

        With Sheet9
            Set NewRw = .ListObjects("Tbl_Navigation_Links").ListRows.Add(AlwaysInsert:=True)
            ' adds a new row to the navigation table
            With .Hyperlinks.Add(NewRw.Range(1, 7), "")
                ' adds a hyperlink in the newly added row of the table, in the 7th column
                .SubAddress = rng.Parent.Name & "!" & rng.Resize(40, 10).Address
                ' subaddress property equals location within document associated with the hyperlink
                .ScreenTip = "Yet another tasteful meal at [" & .SubAddress & "]"
                ' whenever mouse hovers over ...
                .TextToDisplay = myValue
            End With
        End With
    End If
End Sub

Worked perfectly as far as I can tell. I wish I had the time and inclination to learn VBA properly. Thank you for this, I'll read it over and maybe learn something as well.

 

[GWteB]

You are welcome and thanks for letting me know.