I have the following code which doesn't seem to work when replacing hyperlinks:
Sub ReplacePartHyperlinkAddress()
Dim hLink As Hyperlink
Dim wSheet As Worksheet
For Each wSheet In Worksheets
For Each hLink In wSheet.Hyperlinks
hLink.Address = Replace(hLink.Address, "File:///C:\Users/username/AppData/roaming", "O:\Brisbane\Brisbane_Groups\Offices")
Next hLink
Next wSheet
End Sub
Can somebody please help me with this, also I may be trying to execute it the incorrect way in excel.
The old link is starting with File:///, you should also let your new link to a (network)drive location start with that:
hLink.Address = Replace(hLink.Address, "File:///C:\Users/username/AppData/roaming", _
"File:///O:\Brisbane\Brisbane_Groups\Offices")
Also I think your initial link looks strange, as when I create a link all slashes in the path are backward "\": "File:///C:\Users\username\AppData\roaming"
Related
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
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 am new to this site, I have a workbook, (Costing-Calculator) and in the workbook, I have many worksheets, but the sheets I am concerned with are named (Tour_Fare_&_Analysis) and (RoutePlanner).
What I want to do is Copy the Route Planner and place it after all other worksheets with values only (Without original formulas) and rename this new copy with value from Cell ("G2") in worksheet (Tour_Fare_&_Analysis).
In my searches I have found a code that did work initially, but later when I tried to change the code to make copy values only, i dont know what went wrong and even the original code is brining back error msg. The code I am using is as below and i have put the error ms too following the code.
Dim Test As Worksheet
Sheets("RoutePlanner").Copy After:=Sheets(Sheets.Count)
Set Test = ActiveSheet
ActiveSheet.Name = Sheets("Costing Summery").Range("G2").Value
Error Msg:
Run-Time error'1004':
Cannot rename a sheet to the same name as another sheet, a referenced object library or a workbook referenced by Visual Basic.
Please can anyone help me solve this issue, I will really appreciate any help as I have turned the google serches up-side down to try and find the answer to the error msg i am getting.
Been a while since the question, but here is how I solved a similar problem. I allow it to use the same name, but add a sequence number to the name.
(I also gotten into the habit of inserting stuff first or at the top, since I rearly need to look at the things I created a year ago, saves me the time of going to the end/bottom of everything.)
Sub OrderConfirmation()
Dim newsheet As Worksheet
Dim i As Integer
Dim OCNO As String
OCNO = "OC #" & ' adding the order number from a different sheet/row that Im working with
Worksheets("Template").Copy before:=Worksheets(1)
Set newsheet = ActiveSheet
On Error Resume Next
newsheet.Name = OCNO
If Err.Number = "1004" Then
For i = 1 To 10
On Error Resume Next
newsheet.Name = OCNO & "(" & i & ")"
If Not Err.Number = "1004" Then i = 10
Next i
End If
End Sub
I'm in the process of refactoring a huge workbook woth a lot of legacy parts, redundant computations, cross-dependencies etc.
Basically, I'm trying to remove unneeded sheets and implement some proper information flow within the workbook. Is there a good way to extract the dependencies between the sheets (with VBA)?
Thanks
Martin
You can use ShowPrecedents and NavigateArrow.
here is some pseudocode
for each oCell in oSht containing a formula
ocell.showprecedents
do until nomoreprecedents
i=i+1
Set oPrec = oCell.NavigateArrow(True, 1, i)
If not oPrec.Parent Is oSht Then
' off-sheet precedent
endif
loop
next ocell
I came up with a little sub to do this. It moves all the sheets into seperate workbooks and prints out the dependencies. The advantage over using showPrecedents is that it captures all links including names, embedded forms/diagramms etc.
Word of warning: Moving worksheets isn't undo-able, save your workbook before running this and close (without saving) and re-open afterwards.
Sub printDependencies()
' Changes workbook structure - save before running this
Dim wbs As VBA.Collection, wb As Workbook, ws As Worksheets
Dim i As Integer, s As String, wc As Integer
Set ws = ThisWorkbook.Worksheets
Set wbs = New VBA.Collection
wbs.Add ThisWorkbook, ThisWorkbook.FullName
For i = ws.Count To 2 Step -1
ws(i).Move
wc = Application.Workbooks.Count
wbs.Add Application.Workbooks(wc), Application.Workbooks(wc).FullName
Next
Dim wb As Workbook
For Each wb In wbs
For Each s In wb.LinkSources(xlExcelLinks)
Debug.Print wb.Worksheets(1).Name & "<-" & wbs(s).Worksheets(1).Name
Next
Next
End Sub
The code isn't very polished or user-friendly, but it works.
You can follow the steps at "Find external references that are used in cells" topic of the following link:
Find external references in a worbook
But instead of enter the "[" you should enter the name of the sheet you're trying to find its dependencies. It will display a large list of every single cell referencing the sheet, but at the end it works. Haven't find the way to group by Sheet.