I am losing my mind over this and I know it is much more simple than I am making it.
I am looking to simply replace multiple occurrences of text with a hyperlink that is masked by the same text.
Scenario: We are moving to Google Classroom due to Covid-19 and we are thinking ahead to September. I can export pupils timetables in bulk to excel as HTML files (lets call this file timetables). I have a separate file with a list of all class names and the links for the Google Classrooms (lets call this one classes). I have copied these values into 'Sheet1' of the timetable file for the code below.
If I can use the classes list to search for all occurrences of the classes in the timetables then replace them with the hyperlink to the google classroom but I want it to appear as the classname.
This is an image of the timetable file. This is one timetable but the file continues the same pattern for different pupils
This is an image of the classlist file. Imagine there were all classes listed and links were valid.
I have been trying this code that I found but cannot get a working hyperlink in the "replace" element.
'PURPOSE: Find & Replace a list of text/values throughout entire workbook from a table
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault
Dim sht As Worksheet
Dim fndList As Integer
Dim rplcList As Integer
Dim tbl As ListObject
Dim myArray As Variant
'Create variable to point to your table
Set tbl = Worksheets("Sheet1").ListObjects("Table2")
'Create an Array out of the Table's Data
Set TempArray = tbl.DataBodyRange
myArray = Application.Transpose(TempArray)
'Designate Columns for Find/Replace data
fndList = 1
rplcList = 2
'Loop through each item in Array lists
For x = LBound(myArray, 1) To UBound(myArray, 2)
'Loop through each worksheet in ActiveWorkbook (skip sheet with table in it)
For Each sht In ActiveWorkbook.Worksheets
If sht.Name <> tbl.Parent.Name Then
sht.Cells.Replace What:=myArray(fndList, x), Replacement:=myArray(rplcList, x), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
End If
Next sht
Next x
End Sub
Help is appreciated.
Try this. It appears that the link requires the full address including "https".
I mocked up a two-column table and a few values to test.
Sub x()
Dim r As Range, t As ListObject, rFind As Range, s As String
With Worksheets("Sheet1")
Set t = .ListObjects("Table1")
For Each r In t.ListColumns(1).DataBodyRange 'loop through first column of table
Set rFind = .Range("A:C").Find(What:=r.Value, Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False) 'look for value
If Not rFind Is Nothing Then
s = rFind.Address 'store address of first cell
Do
.Hyperlinks.Add Anchor:=rFind, Address:=r.Offset(, 1).Value, SubAddress:="", ScreenTip:=r.Offset(, 1).Text, TextToDisplay:=r.Value 'add hyperlink
Set rFind = .Range("A:C").FindNext(rFind) 'look for next instance
Loop While rFind.Address <> s 'keep going until back to first case
End If
Next r
End With
End Sub
Before
After
Links table
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.