Goal:
Replace the display text for any hyperlinks in an Excel sheet starting with www.google.com with Google while maintaining the original hyperlink URL and cell position.
I'm bashing together what I found online, like How To Change Multiple Hyperlink Paths At Once In Excel?.
I feel I'm close with:
Sub ReplaceHyperlinks()
Dim Ws As Worksheet
Dim xHyperlink As Hyperlink
Set Ws = Application.ActiveSheet
For Each xHyperlink In Ws.Hyperlinks
xHyperlink.TextToDisplay = Replace(xHyperlink.TextToDisplay, "www.google.com/*", "Google")
Next
End Sub
Use mid and find like
=MID(A1,5,FIND(".",A1,5)-5)
Edit:
So use hyperlink like
=HYPERLINK(B1,PROPER(B1))
Try this:
Sub ReplaceHyperlinks()
Dim Ws As Worksheet
Dim lnk As Hyperlink
Set Ws = Application.ActiveSheet
For Each lnk In Ws.Hyperlinks
If LCase(lnk.Address) Like "*google.com*" Then 'Google link ?
lnk.TextToDisplay = "Google"
End If
Next
End Sub
Related
I was able to make a somewhat pseudo api for whatsapp using the excel formulas, but to fully automate the process i need a macro that acess the hyperlinks i generate in a cascade like event.
Like i have each link in a cell:
Link1
link2
link3
link4
I need a macro that start opening; link 1, after 5-10seconds it opens link 2 then after 5-10sec it opens link 3 and there after...
Sub Test()
Dim Sh As Worksheet
Dim Rng As Range
Dim Cell As Range
Set Sh = Worksheets("Master")
With Sh
Set Rng = .Range("G1:G" & .Cells(.Rows.Count, "G").End(xlUp).Row)
End With
For Each Cell In Rng
ThisWorkbook.FollowHyperlink Cell.Value
Next Cell
End Sub
this one nearly solved my issue ThisWorkbook.FollowHyperlink Cell.Value but i cant get this part pass tru the debuger and im not being able to issue a timer to the sintax
When I run this macro on a selected column of hyperlinks, two tabs open for each link.
Sub BatchOpenHyperLinks_SelectedRanges()
Dim objSelectedRange As Excel.Range
Dim objHyperlink As Excel.Hyperlink
'Get selected ranges
Set objSelectedRange = Excel.Application.Selection
For Each objHyperlink In objSelectedRange.Hyperlinks
objHyperlink.Follow
Next
End Sub
Check your selection. I tested this and only one tab opened:
Sub BatchOpenHyperLinks_SelectedRanges()
Dim thisHyperlink As Hyperlink
For Each thisHyperlink In Selection.Hyperlinks
thisHyperlink.Follow
Next
End Sub
I have a row with hundreds of hyperlinks pointing to a path that was changed a bit. can someone help me with creating a vbscript in excel. I have some code I found but it is not working very good. There are a few conditions I have to take in consideration that some of the links are correct and no need to edit and some I just need to edit a little bit. Here is an example of three rows.
\\US.MyCompany.net\Main_Folder\DATA\Sub_folder\a\file1.pdf
\\US.MyCompany.net\Main_Folder\DATA\Sub_folder\b\file1.pdf
\\US.MyCompany.net\Main_Folder\DATA\Sub_folder\c\file1.pdf
I basically need to edit the current path and add a folder named NewFolder right after the DATA so it would look like the following.
\\US.MyCompany.net\Main_Folder\DATA\NewFolder\Sub_folder\a\file1.pdf
\\US.MyCompany.net\Main_Folder\DATA\NewFolder\Sub_folder\b\file1.pdf
\\US.MyCompany.net\Main_Folder\DATA\NewFolder\Sub_folder\c\file1.pdf
The code I got so far works but only to the exact search meaning it will add Newfolder even if it exist it will not skip it.
When I run the code bellow a few times it will keep on adding the Newfolder even if it exist.
Sub ReplaceHyperlinkAdresses()
Dim hypLink As Hyperlink
Dim ws As Worksheet
For Each ws In Worksheets
For Each hypLink In ws.Hyperlinks
If hypLink.Address Like "\\US.MyCompany.net\Main_Folder\DATA*" Then
hypLink.Address =Replace
(hypLink.Address, "\\US.MyCompany.net\Main_Folder\DATA",
"\\US.MyCompany.net\Main_Folder\DATA\NewFolder")
End If
Next hypLink
Next ws
End Sub
Sub ReplaceHyperlinkAdresses()
Dim hypLink As Hyperlink
Dim ws As Worksheet
For Each ws In Worksheets
For Each hypLink In ws.Hyperlinks
If hypLink.Address Like "\\US.MyCompany.net\Main_Folder\DATA*" AND _
Not hypLink.Address Like "\\US.MyCompany.net\Main_Folder\DATA\NewFolder*"Then
hypLink.Address =Replace(hypLink.Address, _
"\\US.MyCompany.net\Main_Folder\DATA", _
"\\US.MyCompany.net\Main_Folder\DATA\NewFolder")
End If
Next hypLink
Next ws
End Sub
Is it possible to stop following hyperlinks in Excel? I am very open to using macros and other methods. I found the following types of "solutions" after hours of searching but they would not work:
Disable all hyperlinks by using Selection.Hyperlinks.Delete
Have Excel turn off automatic hyperlink-ing
Have a dummy sheet with the hyperlinks that links to itself and use VBA for activation on follow
These do not work since I don't own the worksheet. My job is to automate reports/actions/calculations of my coworkers using user formulas or subs. The owner of the worksheet have lots of links included in the file which they would wish to keep. I cannot just arbitrarily remove their links. But troubleshooting and programming for me is difficult since I sometimes (not often, I usually use keyboard to navigate, but sometimes) accidentally click a link and there'll be popups and all that junk. I also cannot create a dummy sheet, since the worksheet contains some 10,000 lines of data, I'm afraid it would inflate the file size. Any help would be appreciated! Thanks!
I assume you want to temporarily disable the hyperlinks while you're working on the file, and then re-enable them when you've finished. One possible solution would be to store them in a seperate, temporary sheet.
Sub DisableLinks()
Dim ws As Worksheet
Dim ts As Worksheet
Set ts = ActiveSheet
Set ws = Worksheets.Add(after:=ts)
Dim hylink As Hyperlink
Dim destlink As Hyperlink
For Each hylink In ts.Hyperlinks
If hylink.Range.Value <> "" Then
ws.Range(hylink.Range.Address) = hylink.Range.Value
If hylink.SubAddress = "" Then
Set destlink = ws.Hyperlinks.Add(anchor:=ws.Range(hylink.Range.Address), Address:=hylink.Address, TextToDisplay:=hylink.TextToDisplay)
Else
ws.Hyperlinks.Add anchor:=ws.Range(hylink.Range.Address), Address:=hylink.Address, SubAddress:=hylink.SubAddress, TextToDisplay:=hylink.TextToDisplay
End If
hylink.Delete
End If
Next hylink
ws.Visible = xlVeryHidden
End Sub
Sub RestoreLinks()
Dim ws As Worksheet
Dim ts As Worksheet
Set ts = ActiveSheet
Set ws = Worksheets(ts.Index + 1)
ws.Visible = xlSheetVisible
Dim hylink As Hyperlink
For Each hylink In ws.Hyperlinks
If hylink.Range.Value <> "" Then
If hylink.SubAddress = "" Then
ts.Hyperlinks.Add anchor:=ts.Range(hylink.Range.Address), Address:=hylink.Address, TextToDisplay:=hylink.TextToDisplay
Else
ts.Hyperlinks.Add anchor:=ts.Range(hylink.Range.Address), Address:=hylink.Address, SubAddress:=hylink.SubAddress, TextToDisplay:=hylink.TextToDisplay
End If
hylink.Delete
End If
Next hylink
ws.Delete
End Sub
This will remove the hyperlink from the selection you have selected.
Sub removelinks()
Dim rng As Range
For Each r In Selection
rng.Hyperlinks.Delete
Next
End Sub
I want to update a worksheet. The name of the worksheet changes with the date.
As an example the worksheet would have been named
"Hello World 6.13" on Monday
"Hello World 6.17" today
How can I looks for the sheet name that starts with "Hello World" and ignores the date code?
They way I would go about this would be to loop through the sheets in the active workbook and make the comparison, and when the correct sheet "Hello World x.xx" is found set it as a reference, and use this reference to run any further code.
Let searchTerm = "Hello World"
For Each ws In ActiveWorkbook.Sheets
If Left(ws.Name, Len(searchTerm)) = searchTerm Then
Set hwSheet = ws
Exit For
End If
Next ws
'do some code eg:
With hwSheet
.Range("A1").Value = "Hi"
End With
So the spreadsheet you want to capture is always the same sheet, in the same workbook? If I've got this right, you can use the codename of the worksheet in the client's workbook, such as Sheet1 instead of the worksheet name.
Dim wb As Workbook, ws as Worksheet
Set wb = Workbooks("Client.xls")
wb.Activate
Set ws = Sheet1
You would have to activate the appropriate workbook before using the sheet codename. To be sure this works, it would be prudent to change the client's sheet codename to something unique (if it isn't already) if that is within your purview.
Posted below is a version of Oliver's code that addresses working with the found sheet inside the loop, rather than the last found match.
A couple of other minor tweaks
The string version of Left$ is quicker than the variant Left
if you set an object in a loop, should set it back to nothing before retesting (which is not evident in the code below as I used the existing ws)
code
Sub Updated()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Sheets
If Left$(ws.Name, 11) = "Hello World" Then
With ws
'do something
End With
End If
Next ws
End Sub
Another option to return all partial sheet matches without a loop is in Adding Sheet Names to Array in Excel VBA
While I liked #Carrosives answer (https://stackoverflow.com/a/37882970/5079799). I decided to functionalize it. In that regard, I didn't want to use LEFT or RIGHT but InSTR.
Here is what I got:
Public Function FindWorksheet(PartOfWSName As String) As Worksheet
For Each ws In ActiveWorkbook.Sheets
If InStr(ws.Name, PartOfWSName) > 0 Then
Debug.Print ws.Name
Set FindWorksheet = ws
Exit For
End If
Next ws
End Function
Sub TestingSpot_Sub()
Dim PartOfWSName As String
PartOfWSName = "Testz"
Dim ws As Worksheet
Set ws = FindWorksheet(PartOfWSName)
ws.Activate
End Sub
This should be enough:
Sub CallTheRealThing()
Call SelectSheets("Sheet")
End Sub
Sub SelectSheets(NameNeededinSheet As String, Optional Looked_Workbook As Workbook)
Dim WorkSheetProject As Worksheet
If Looked_Workbook Is Nothing Then Set Looked_Workbook = ThisWorkbook
For Each WorkSheetProject In Looked_Workbook.Worksheets
If InStr(WorkSheetProject.Name, NameNeededinSheet) Then: WorkSheetProject.Select: Exit Sub
Next WorkSheetProject
End Sub
You may change it to a Function instead of sub to know if it could select the sheet or not