VBA user input, copy formulas and create hyperlink to sheet

Question

I have a button that asks for user input and a cell selection. The button also inserts a new row at the bottom of the table and is supposed to copy formulas down, but its not. When the user inputs the string, it should match an already existing sheet in the workbook. So I want to match the new cell with the name of existing sheet to create a hyperlink. That's not working either.

Private Sub NewWellButton_Click()
  Dim well As Variant
  Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
   ' Copy formula from cell above
  Rows(Selection.Row).Insert Shift:=xlDown
  ActiveCell.EntireRow.Copy
  ActiveCell.EntireRow.PasteSpecial Paste:=xlPasteFormulas
  Application.CutCopyMode = xlCopy
  Dim ChosenRange As Range
  Set ChosenRange = Application.InputBox(prompt:="Select the next empty cell in column A to input the well name.", Type:=8)
  well = Application.InputBox("Enter the new well name", Title:="New Well")
  ChosenRange.Value = UCase(well)
  ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=well
  On Error Resume Next
  MsgBox "Well names do not match to create hyperlink"
  Exit Sub
End Sub

Then start with [this question](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). — BigBen, Feb 27 '20 at 18:53
It is at least strange to insert selecting the first empty row... Are you sure that this is what you want? What do you expect from `Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select` line to select? It will select the first empty cell of the column A:A. Is this what you want? Are there other cells on that row, after the second column? — FaneDuru, Feb 27 '20 at 19:26

score 1 · Answer 1 · answered Feb 28 '20 at 20:40

The hyperlink SubAddress need to be to a cell on the sheet like 'Sheet Name'!A1.

Option Explicit
Private Sub NewWellButton_Click()

    Dim wb As Workbook, ws As Worksheet, wsNew As Worksheet, sht As Worksheet
    Dim sWellName As String, lastCell As Range, bExists As Boolean, s As String
    Set wb = ActiveWorkbook
    Set ws = wb.Sheets(1)

    sWellName = Application.InputBox("Enter the new well name", Title:="New Well")

    If Len(sWellName) = 0 Then
        MsgBox "Well Name blank", vbExclamation
        Exit Sub
    Else
       For Each sht In wb.Sheets
           If sht.Name = sWellName Then bExists = True
       Next
    End If

    If bExists = False Then
        s = "Sheet [" & sWellName & "] does not exist, do you want to create it ?"
        If vbYes = MsgBox(s, vbYesNo, "Not Found") Then
            Set wsNew = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
            wsNew.Name = sWellName
            ws.Select
        End If
    End If

    ' copy
    Set lastCell = ws.Cells(Rows.Count, 1).End(xlUp)
    lastCell.EntireRow.Copy

    ' paste below
    Set lastCell = lastCell.Offset(1, 0)
    lastCell.PasteSpecial xlPasteFormulas
    Application.CutCopyMode = False

    ' add link
    With lastCell
       .Value = UCase(sWellName)
       .Hyperlinks.Add Anchor:=lastCell, Address:="", SubAddress:="'" & sWellName & "'!A1"
    End With

End Sub

VBA user input, copy formulas and create hyperlink to sheet

1 Answers1