I have some cells in a worksheet that contain Inserted hyperlinks. I want to remove the hyperlinks and leave the "friendly name" in the cell. I can do this with:
Sub dural()
Dim h As Hyperlink
For Each h In ActiveSheet.Hyperlinks
h.Delete
Next h
End Sub
This little Sub works. However if I start with:
and run the macro, I get:
The format of the cell has been ruined! Is there anyway to remove the hyperlink and leave the formatting alone??
EDIT#1:
examining hyperlink properties, I got this to work:
Sub dural2()
Dim h As Hyperlink, addy As String, z As String
For Each h In ActiveSheet.Hyperlinks
addy = h.Range.Address
z = h.Parent
Range(addy).ClearContents
Range(addy).Value = z
Next h
End Sub
The Hyperlink object has certain properties which, through trial and error I established that, for a simple hyperlink to another cell on the same sheet:
h.Address = ""
h.Range = "CNN" (actually returns a Range but as the default property is .Value it evaluates to "CNN")
h.SubAddress = "Sheet1!C1"
As .SubAddress contains:
the location within the document associated with the hyperlink
I changed your code to:
Sub dural()
Dim h As Hyperlink
For Each h In ActiveSheet.Hyperlinks
h.SubAddress = ""
Next h
End Sub
and found that the hyperlink no longer works but your cell formatting is preserved.
Related
I have a shape in an Excel sheet, and I have to add/remove hyperlink to it as a part of my code. How can we check if the shape contains a hyperlink? Something like the below code:
if shape.hyperlink.exists is True then
shape.hyperlink.delete
end if
Public Sub TestMe()
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
On Error Resume Next
sh.Hyperlink.Delete
On Error GoTo 0
Next sh
End Sub
The idea is to delete the hyperlink of every shape. If the shape does not have one, it is quite ok, the code continues. In this solution, the hyperlink is declared as a variable - How do I refer to a shape's hyperlinks using Excel VBA - as a workaround something similar can be used.
It is possible to loop over all the hyperlinks on a sheet and determine whether those hyperlinks are in cells or in Shapes (this avoids using OnError):
Sub HyperActive()
Dim h As Hyperlink, n As Long
If ActiveSheet.Hyperlinks.Count = 0 Then
MsgBox "no hyperlinks"
Exit Sub
End If
For Each h In ActiveSheet.Hyperlinks
n = h.Type
If n = 0 Then
MsgBox "in cell: " & h.Parent.Address
ElseIf n = 1 Then
MsgBox "in shape: " & h.Shape.Name
End If
Next h
End Sub
To check if a Shape has a Hyperlink, call this function (instead of the 'shape.hyperlink.exists') in your post:
Public Function HasHyperlink(shpTarget As Shape) As Boolean
Dim hLink As Hyperlink: Set hLink = Nothing
On Error Resume Next: Set hLink = shpTarget.Hyperlink: On Error GoTo 0
HasHyperlink = Not (hLink Is Nothing)
End Function
I'm programming a Macro in VB for Excel 2013 that search for coincidences in different worksheets, and add a link to the cells that match.
I'm havin torubles to insert the link in the cell, since the link must be different for a range of cells, I need help here.
Here is my code
Dim bufferDetails As String
Dim tmpCell As String
Dim spot As String
Dim cell As Variant
Dim cellSpots As Variant
For Each cell In Worksheets("MMS-Locations").Range("D2:D1833")
If (cell.Value2 = "NULL") Then
cell.Value2 = "NULL"
Else
tmpCell = cell.Text
'A62
If (Left(tmpCell, 3) = "A62") Then
spot = spotName(tmpCell)
For Each cellSpots In Worksheets("DetailedMap").Range("G60:CF123")
If (cellSpots.Value2 = spot) Then
For Each linkToSpot In Worksheets("MMS-Locations").Range("H2:H1833")
Worksheets("MMS-Locations").Hyperlinks.Add _
Anchor:=Range(linkToSpot), _
Address:="http://example.microsoft.com", _
ScreenTip:="Microsoft Web Site", _
TextToDisplay:="Microsoft"
Next linkToSpot
Debug.Print ("Encontrado " + cellSpots)
End If
Next cellSpots
End If
End If
Next cell
End Sub
Function spotName(fullName As String) As String
Dim realSpot As String
Dim lenght As Integer
lenght = Len(fullName) - 3
realSpot = Right(fullName, lenght)
spotName = realSpot
End Function
As I was thinking the linkToSpot variable contains the actual cell in the range, so I can move my selection of the sell, but my code fails in there with this error:
Error in the Range method of the '_Global' object,
Just for reference, here is what I use to convert a phone number to an email for texting..setting it as a hyperlink in the current cell.
ActiveCell.Value = myNumbr
Set myRange = ActiveCell
ActiveSheet.Hyperlinks.Add anchor:=myRange, Address:="mailto:" & myRange.Value, TextToDisplay:=myRange.Value`
Keep your code simple to start with, until you find a working script, then add other items. Make good use of the F8 key to step through your code to find out exactly where an error occurs.
I have a spreadsheet that is used for tracking work orders. The first column of the sheet has numbers starting at 14-0001 and continue sequentially all the way down. The numbers were hyperlinked to the .XLS of their respective work order (ex. the cell containing 14-0001 links to Z:\WorkOrders\14-0001-Task Name\14-0001-Task Name.xls)
Problem is, My computer crashed and when Excel recovered the file all the hyperlinks changed from:
**"Z:\blah blah\WorkOrders\14-****-Task Name\14-****-Task Name.xls"**
to
**"C:\Users\blahblah\WorkOrders\14-****-Task Name\14-****-Task Name.xls"**
There are hundreds of entries so I was hoping that I could run a script to fix all of the hyperlinks.
Heres a script I found online which from what I understood is supposed to do what I want, but when I run the script from the VB window in Excel I get "Compile error: Argument not optional" and it highlights Sub CandCHyperlinx()
Code:
Option Explicit
Sub CandCHyperlinx()
Dim cel As Range
Dim rng As Range
Dim adr As String
Dim delstring As String
'string to delete: CHANGE ME! (KEEP quotes!)
delstring = "C:\Users\***\AppData\Roaming\Microsoft\Excel\"
'get all cells as range
Set rng = ActiveSheet.UsedRange
'ignore non hyperlinked cells
On Error Resume Next
'check every cell
For Each cel In rng
'skip blank cells
If cel <> "" Then
'attempt to get hyperlink address
adr = cel.Hyperlinks(1).Address
'not blank? then correct it, is blank get next
If adr <> "" Then
'delete string from address
adr = Application.WorksheetFunction.Substitute(adr, delstring)
'put new address
cel.Hyperlinks(1).Address = adr
'reset for next pass
adr = ""
End If
End If
Next cel
End Sub
Is this even the right script? What am I doing wrong?
Try this:
Sub Macro1()
Const FIND_TXT As String = "C:\" 'etc
Const NEW_TXT As String = "Z:\" 'etc
Dim rng As Range, hl As Hyperlink
For Each rng In ActiveSheet.UsedRange.Cells
If rng.Hyperlinks.Count > 0 Then
Set hl = rng.Hyperlinks(1)
Debug.Print rng.Address(), "Before", hl.TextToDisplay, hl.Address
hl.TextToDisplay = Replace(hl.TextToDisplay, FIND_TXT, NEW_TXT)
hl.Address = Replace(hl.Address, FIND_TXT, NEW_TXT)
Debug.Print rng.Address(), "After", hl.TextToDisplay, hl.Address
End If
Next rng
End Sub
I've just had the same problem, and all the macros I tried didn't work for me. This one is adapted from Tim's above and from this thread Office Techcentre thread. In my case, all my hyperlinks were in column B, between rows 3 and 400 and 'hidden' behind the filename, and I wanted to put the links back to my Dropbox folder where they belong.
Sub FixLinks3()
Dim intStart As Integer
Dim intEnd As Integer
Dim strCol As String
Dim hLink As Hyperlink
intStart = 2
intEnd = 400
strCol = "B"
For i = intStart To intEnd
For Each hLink In ActiveSheet.Hyperlinks
hLink.TextToDisplay = Replace (hLink.TextToDisplay, "AppData/Roaming/Microsoft/Excel",
"Dropbox/References")
hLink.Address = Replace(hLink.Address, "AppData/Roaming/Microsoft/Excel",
"Dropbox/References")
Next hLink
Next i
End Sub
Thanks for your help, Tim!
I read an excel file and on a cell I got a text like this:
"=- Bla Bla Bla".
This will not be recognize and will show #NAME?
So if you need to read some cell and get it into database this error in the file will show as Error 2029. The script will freeze.
So, can I pre-replace the content if I get = or - chars in the cell so I validate the content before I read it and get the error. Can I pass over it!
I need cell validation
Private Sub Worksheet_Change(ByVal Target As Range)
c = Target.Cells.Column
r = Target.Cells.Row
'validate cell
End If
Thank you!
Is this what you are trying?
Sub Sample()
Dim sTemp As String
With Sheets("Sheet1")
'~~> Check if cell has error
If IsError(.Range("A1").Value) Then
'~~> Check if it is a 2029 error
If .Range("A1").Value = CVErr(2029) Then
'~~> Get the cell contents
sTemp = Trim(.Range("A1").Formula)
'~~> Remove =/-
Do While Left(sTemp, 1) = "=" Or Left(sTemp, 1) = "-"
sTemp = Trim(Mid(sTemp, 2))
Loop
'~~> Either put it in back in the cell or do
'~~> what ever you want with sTemp
.Range("A1").Formula = sTemp
End If
End If
End With
End Sub
I got it working
'verify cell for data
Private Sub Worksheet_Change(ByVal Target As Range)
c = Target.Cells.Column
r = Target.Cells.Row
If IsError(Target.Worksheet.Cells(r, c)) Then
MsgBox "You have a validation Error!"
Target.Worksheet.Cells(r, c) = ""
End If
End Sub
You can also add Data Validation to your worksheet to prevent things from being entered that way. Under "Validation criteria", allow "Custom" and enter this formula:
=NOT(OR(IF(EXACT(LEFT(TRIM(A1),1),"-"),1,0),IF(EXACT(LEFT(TRIM(A1),1),"="),1,0)))
If the value entered in the cell begins with a "-" or "=" (with leading spaces), then it won't accept it. If the person typed in =123, then it would be valid since it's treated like a formula and will only see it as 123.
If you don't want the cell to contain = or - at all, then try this for your data validation formula. Again, it won't be able to catch a formula like =NOW() or =-hi (it would see #NAME? for -hi), but it will reject =-123 since it sees -123. If you have the cells formatted as Text, then it will reject any cell with = or - inside because values starting with = aren't treated like formulas.
=NOT(OR(ISNUMBER(FIND("=",A18)),ISNUMBER(FIND("-",A18))))
I'd like to create a VBA macro which would allow me to edit all selected hyperlinks in a column and change "text to display" to the same word for all. For example, if this was the column:
www.google.com/search=cars
www.google.com/search=houses
www.google.com/search=cities
I would want to highlight those three elements of the column and change the text to display to "Google Search" so that the outcome would be this:
Google Search
Google Search
Google Search
Edit: So I found a macro similar to what I want to do on the microsoft support site, but my issue is that this macro targets all the hyperlinks in the sheet while I'd want to select a specific column to edit the hyperlinks.
Sub HyperLinkChange()
Dim oldtext As String
Dim newtext As String
Dim h As Hyperlink
oldtext = "http://www.microsoft.com/"
newtext = "http://www.msn.com/"
For Each h In ActiveSheet.Hyperlinks
x = InStr(1, h.Address, oldtext)
If x > 0 Then
If h.TextToDisplay = h.Address Then
h.TextToDisplay = newtext
End If
h.Address = Application.WorksheetFunction. _
Substitute(h.Address, oldtext, newtext)
End If
Next End Sub
This works on the current selection:
Sub SetLinkText()
Dim LinkText As String
Dim h As Hyperlink
LinkText = InputBox("Enter link text")
If LinkText = "" Then Exit Sub
For Each h In Selection.Hyperlinks
h.TextToDisplay = LinkText
Next
End Sub