I have a sheet with the string "Title" repeating several times in Column B. For each instance of Title I want to place a hyperlink to the same cell in the value a row directly under it (ie if title is in B1 I would like a hyperlink in B2).
So if the hyperlink was in B2 effectively it would do nothing but say on the same cell when clicked.
However, I need the exsting value in cell B2 to not change, all that will happen is it will go from a regular value to a hyperlinked value.
Below is what I have come up with thus far, keep in mind im pretty new to VBA so pointers are appreciated.
Sub RunThis()
'Declare workbook and worksheets:
Dim mainFile As Workbook, titleDetailSheet As Worksheet
Set mainFile = ActiveWorkbook
Set titleDetailSheet = mainFile.Sheets("Title Detail")
Dim searchString As String
searchString = "Title"
For r = 1 To 200
If titleDetailSheet.Range("B" & r) = searchString Then
titleDetailSheet.Range("B" & r + 1) = **'ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=titleDetailSheet.Name & "!A1", TextToDisplay:="Title"**
End If
Next r
End Sub
I'm not sure what the correct syntax would be for the bolded script.
you would need something like this
If titleDetailSheet.Range("B" & r) = searchString Then
mainFile.ActiveSheet.Hyperlinks.Add _
Anchor:=titleDetailSheet.Range("B" & r + 1), _
Address:="", _
SubAddress:="'" & titleDetailSheet.Name & "'!" & titleDetailSheet.Range("B" & r).Address, _
TextToDisplay:=titleDetailSheet.Range("B" & r + 1).Value
End If
Kindly see if you can understand the syntax and just ask me if there are unclear items. ^-^
In
Set mainFile = ActiveWorbook
you misspelled Activeworkbook.
The part
SubAddress:=titleDetailSheet.Name & "!A1"
is a tricky one:
SubAddress:="'" & titleDetailSheet.Name & "'!A1"
Your variables are miles long. Try to shorten them.
Option Explicit
'With Project ==================================================================
' .Title: HyperlinkBColumn
' .Author: YMG
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' With .Contents
' Sub HyperlinkBColumn
' End With
'===============================================================================
'
'-------------------------------------------------------------------------------
Sub HyperlinkBColumn()
'
'Description:
' Loops through a specified column and when a specified value is found, puts
' a hyperlink in the cell below.
'Arguments
' None
'Returns
' Hyperlinks on worksheet, Debugging info in the Immediate Window
'
'--Customize BEGIN ---------------------
Const cWsName As String = "Title Detail"
Const cSearch As String = "Title"
Const cRow1 As Integer = 1
Const cRow2 As Long = 200
Const cCol As String = "B"
Const cHeader As String = "Processing rows..." 'Immdediate Window
Const cFooter As String = "...finished processing." 'Immediate Window
'--Customize END -----------------------
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim oWb As Workbook
Dim oWs As Worksheet
Dim rCell1 As Range
Dim rCell2 As Range
Dim iR As Integer
Dim strText As String
Dim strAddr As String
Dim str1 As String 'Immediate Window
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set oWb = ActiveWorkbook
Set oWs = oWb.Worksheets(cWsName)
For iR = cRow1 To cRow2
Set rCell1 = oWs.Range(cCol & iR)
Set rCell2 = oWs.Range(cCol & iR + 1)
strText = rCell2.Text 'What's written in the cell.
strAddr = rCell2.Address 'The address e.g. B1, B13 ...
If rCell1 = cSearch Then
If strText <> "" Then
'Anchor is the place where to put the hyperlink, cell or object.
'Notice the single quotes (') in the SubAddress.
'Readability is very important, notice every argument on its own line.
'It's much easier to find a mistake.
rCell2.Hyperlinks.Add _
Anchor:=rCell2, _
Address:="", _
SubAddress:="'" & oWs.Name & "'!" & strAddr, _
TextToDisplay:=strText 'The same text as requested
str1 = str1 & vbCrLf & iR & ". " & rCell1.Address & " " _
& strText & " - at " & strAddr 'Immediate Window
Else
'Put in here what to do if the cell below the Title cell is empty.
'I've chosen to skip the line.
End If
End If
Next
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
str1 = cHeader & str1 & vbCrLf & cFooter 'Immediate Window
Debug.Print str1 'Immediate Window
'
End Sub
'-------------------------------------------------------------------------------
'
'With Idea Source --------------------------------------------------------------
' .Title: Excel VBA creating a Hyperlink to the same cell
' .TitleURL: https://stackoverflow.com/questions/52527595/excel-vba-creating-a-hyperlink-to-the-same-cell
' .Author: Nayan
' .AuthorURL: https://stackoverflow.com/users/10416060/nayan
'End With ----------------------------------------------------------------------
'
'End With ======================================================================
One question only: Why would you create the hyperlink to point to the same cell where it is?
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.