Macro which creates a Hyperlink on the next available blank row?

**dandavis1** · 03-11-2010, 07:50 AM

First of all I dont even know if this is achievable. I have been set a task for work, and have been asked to create this, if at all possible.

An example is attached.

The macro needs to be assigned to one button. I have filled in one row of data (row 6), so before i fill row 7 I need to click the button which would firstly create a new sheet (which i seem to have managed to do) and secondly create a hyperlink which would go in D7 and be linked with the sheet thats just been added.

Follow the same process above, but the hyperlink would need to be placed in D8 then D9, D10 and so on, is this possible to keep the macro all on one button.

Like i said i dont even know if this is possible but if anyone can help, really appreciate it!!!

**buran** · 03-11-2010, 09:04 AM

Hi,
May be something like this:

Sub NewWSHyperlink()
    Dim NextRow As Long
    Dim MainSheet As Worksheet
    Dim NewSheet As Worksheet

    Application.ScreenUpdating = False
    Set MainSheet = ActiveSheet
    NextRow = ActiveSheet.Range(Cells(Rows.Count, 4), Cells(Rows.Count, 4)).End(xlUp).Row + 1
    Set NewSheet = Sheets.Add
    MainSheet.Activate
    ActiveSheet.Hyperlinks.Add Anchor:=MainSheet.Cells(NextRow, 4), Address:="", SubAddress:= _
                               NewSheet.Name & "!A1", TextToDisplay:=NewSheet.Name
    Application.ScreenUpdating = True
End Sub

Buran

**antoka05** · 03-11-2010, 09:07 AM

You can try with this code:

Sub Macro1()
    Dim sh1 As Worksheet
    Dim newSh As Worksheet
    Dim firstFreeRow As Long
    
    Set sh1 = ThisWorkbook.Sheets("sheet1")
    firstFreeRow = sh1.Cells(Rows.Count, "d").End(xlUp).Row + 1
    
    With ThisWorkbook
       Set newSh = .Sheets.Add(, .Sheets(.Sheets.Count))
       newSh.Name = "Sheet" & .Sheets.Count
    End With
    sh1.Hyperlinks.Add Anchor:=sh1.Cells(firstFreeRow, "d"), Address:="", _
       SubAddress:=newSh.Name & "!A1", TextToDisplay:=newSh.Name & "!A1"
End Sub

Regards,
Antonio

**contaminated** · 03-11-2010, 09:35 AM

Hi try this code out

Sub Test()
    Dim LastRow As Long, HypelinkCell As Range
    With Range("D5:D20000")
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With
    
    Set HypelinkCell = Range("D" & LastRow + 1)
    
'   Adding sheets
    Sheets.Add After:=Sheets(Sheets.Count)
    
'   Hyprlinking
    HypelinkCell.Hyperlinks.Add Anchor:=HypelinkCell, _
                                Address:="", _
                                SubAddress:=Sheets(Sheets.Count).Name & "!C21", _
                                TextToDisplay:=Sheets(Sheets.Count).Name
    Sheets("Sheet1").Activate
End Sub