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
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
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 working on a macro that will cycle through all of the sheets in the active workbook and will then clear a certain part of a particular worksheet, based on whether one of the relevant keywords is contained in the worksheet name. In each case the worksheet name will be different, but any I want to clear will contain one of the key words below.
I have set up a separate macro to clear the range of cells in each case. If the Worksheet name does not contain any of the keywords, I want the macro to move onto the next worksheet.
My ultimate aim is to be able to apply this to numerous different workbooks, as the project I am working on is split by region, with a separate Excel file per region.
The code I have been trying is below. There are no errors appearing when I run the code, the code does not seem to run either, in fact nothing at all happens!
Any guidance or advice would be greatly appreciated.
Sub Loop_Customer_Sheets()
Dim ws As Integer
Dim i As Integer
ws = ActiveWorkbook.Worksheets.Count
For i = 1 To ws
If ActiveSheet.Name Like "*ABC*" Then
Call ABCInfoClear
ElseIf ActiveSheet.Name Like "*DEF*" Then
Call DEFInfoClear
ElseIf ActiveSheet.Name Like "*GHI*" Then
Call GHIInfoClear
Else:
End If
Next i
End Sub
"Nothing at all happens" - fixing the issue with your code:
Your issue is that you are looping through the number of sheets, but you are only checking the ActiveSheet, which never changes! Replace your code with
ws = ActiveWorkbook.Worksheets.Count
For i = 1 To ws
With ActiveWorkbook.WorkSheets(i)
If .Name Like "*ABC*" Then
ABCInfoClear
ElseIf .Name Like "*DEF*" Then
DEFInfoClear
ElseIf ActiveSheet.Name Like "*GHI*" Then
GHIInfoClear
End If
End With
Next i
Note: you don't need the Call keyword, you can just call subs as presented above.
Alternative solutions
A better option than having numerous macros might be to create a generic sub like
Sub ClearRangeInSheet(rangeAddress As String, sh As WorkSheet)
Dim myRange As Range
Set myRange = sh.Range(rangeAddress)
myRange.ClearContents
' Any other cell clearing code e.g. for formatting here
End Sub
Then call in the loop
Dim wsCount as Long
wsCount = ActiveWorkbook.WorkSheets.Count
For i = 1 to wsCount
With ActiveWorkbook
If .WorkSheets(i).Name Like "*ABC*" Then
' Always pass ".WorkSheets(i)", but change the range address as needed
ClearRangeInSheet("A1:A20", .WorkSheets(i))
ElseIf ' Other worksheet name conditions ...
End If
End With
Next I
As suggested in the comments, you could ditch indexing the sheets, and just loop through the sheet objects themselves:
Dim wksht as WorkSheet
For Each wksht In ActiveWorkbook.WorkSheets
If wksht.Name Like "*ABC*" Then
' Always pass wksht but change the range address as needed
ClearRangeInSheet("A1:A20", wksht)
ElseIf ' Other worksheet name conditions ...
End If
Next wksht
I have the following code adding sheets from one workbook to another. However, I only want to add the values and not the formulae. How do I achieve this?
Sub publish()
Dim new_wb As Workbook
Dim old_wb As Workbook
Dim i As Long
Dim new_file_path As String
Call refresh_output_sheets
new_file_path = Range("output_path").Value
Set old_wb = ActiveWorkbook
Set new_wb = Workbooks.Add
For Each sh In old_wb.Sheets
If InStr(LCase(sh.CodeName), "output") <> 0 Then
sh.Copy After:=new_wb.Sheets(new_wb.Sheets.Count)
End If
Next sh
Not thoroughly tested but hopefully this will get you close. Replace your copy loop with something like this:
For Each sh In old_wb.Sheets
If InStr(LCase(sh.CodeName), "output") <> 0 Then
sh.Copy
new_wb.Sheets(new_wb.Sheets.Count).PasteSpecial Paste:=xlPasteValues
End If
Next sh
If it's giving you fits, let me know and I'll do some more testing.
Once you have copied a worksheet to the new workbook, activate it and run this:
Sub ClearFormulas()
On Error Resume Next
ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas).ClearContents
End Sub
So basically, remove the formulas after the copy has been made.
Use this:
...
sh.Copy After:=new_wb.Sheets(new_wb.Sheets.Count)
new_wb.Sheets(new_wb.Sheets.Count).Cells.Values=sh.Cells.Values
End If
...
As you know, first statement will copy all data.
Then, new worksheet values are assigned from source, removing all formulas.
I find useful make .Copy before using .Value to copy formats, column widths, ...
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"