VBA - Hyperlinks.add - place in this document

Marty Plante

New Member
Joined
Dec 28, 2016
Messages
11
Office Version
  1. 365
Platform
  1. Windows
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.
 

Some videos you may like

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
1,295
Office Version
  1. 2013
Platform
  1. Windows
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

New Member
Joined
Dec 28, 2016
Messages
11
Office Version
  1. 365
Platform
  1. Windows
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

Well-known Member
Joined
Sep 10, 2010
Messages
1,295
Office Version
  1. 2013
Platform
  1. Windows
See how far you can get with this. Adjustments are always possible, just let me know.

VBA Code:
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
 
Solution

Marty Plante

New Member
Joined
Dec 28, 2016
Messages
11
Office Version
  1. 365
Platform
  1. Windows
See how far you can get with this. Adjustments are always possible, just let me know.

VBA Code:
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

Well-known Member
Joined
Sep 10, 2010
Messages
1,295
Office Version
  1. 2013
Platform
  1. Windows
You are welcome and thanks for letting me know.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,847
Messages
5,627,239
Members
416,232
Latest member
Ash1432

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top