HyperLinks Cell Content Automation

[kkorp]

I have a spreadsheet that we tracks our dell computers in. I have use the first column for the service tag. I would like to be able to have the sheet automatically create a hyperlink base off the content typed in the service tag column/cell and assign the service tag as the display text in the same cell and/or when you enter a new service tag. It would helpful to the others that use the spreadsheet when they need to look up anything about a specific Dell PC/Laptop.

Below is the URL that would point to the dell site.
The red text is the Service Tag Number passed from the cell.
This URL is Hyperlinked to the content of the cell and the display text is the same as the content of the Service Tag text. Also if the cell is empty don't create URL Hyperlink.

Product Support | Dell US

######/overview

P.S. is the possible

 

[Candyman8019]

I do something similar with a defect tracker. The user enters the applicable test case then VBA replaces that with a hyperlink to the correct test case. To accomplish this, I have the following in a worksheet_change event. In this case, the user enters the test number in column C. The hyperlink then looks up that number on the 'Test Cases' sheet and links to the applicable cell. If the specific test case is not found, it will display 'Test Not Found'. You should be able to adapt this to your serial numbers. One thing to note is the # symbol is required in this formula, otherwise it will try to open the hyperlink in the browser rather than link to it in the workbook.

Private Sub worksheet_change(ByVal target As Range)

Dim Tempvar As string
'Create Hyperlink to test case number entered in cell
If Not Intersect(target, Sheet11.Range("C10:C1000")) Is Nothing Then
Tempvar = target.Value
Application.EnableEvents = False
  target.Formula = "=IFERROR(HYPERLINK(""#'Test Cases'!A""&MATCH(" & Tempvar & ",'Test Cases'!A$6:A$9999,0)+5,""Link to test " & Tempvar & """),""Test Not Found"")"
Application.EnableEvents = True
End If

End Sub

 

[kkorp]

I tried your code, but it didn't work for some reason.

I need it to always be checking column "A" from A3 to about A203 for any existing on new input, but to also leave blank cells alone in Column "A". I'm not a code guy so i'm trying to understand if this is even possible. I'm trying to track dell service tags, any help in this matter would be greatly appreciated.

Thanks
The New Guy

 

[kkorp]

I missed by saying that the hyperlinks is applied to the same "A" cell your typing the service tag number in. So I automatically applies the hyperlink to any existing tags and/or to any new ones typed in, if that makes any sense.

 

[Candyman8019]

A couple of things…

You’ll need to change the reference to sheet11 to whatever sheet you’re using…you could also use activesheet in this case. Also, you’ll need to change references to ‘test cases’ to the name of the sheet you’re hyperlinking to.

And lastly the intersect range should be changed to the rage you want to watch…ie A2:a207 for example.

 

[kkorp]

Am I applying the code to a module or a sheet

 

[Candyman8019]

to the specific sheet...

 

[kkorp]

I was able to get this code to work, thanks to your help. Now when the text is deleted from the cell the code is imbedded in the cell and can't be removed. Is it possible to have the code only store the hyperlink to the text and not the cell itself, and is there a way to stop it from changing the text color and underlining it. I'm trying to make the sheet look like a normal spreadsheet.


Private Sub Worksheet_Change(ByVal target As Range)
If target.Cells.Count > 1 Then Exit Sub
If Intersect(target, Range("A4:A6")) Is Nothing Then Exit Sub
Application.EnableEvents = False
target.Formula = "=HYPERLINK(""Product Support | Dell US" & target.Value & "/overview"",""" & target.Value & """)"
Application.EnableEvents = True
End Sub

 

[Candyman8019]

when you say it can't be removed...is your sheet protected? If you want to remove the link you would need to unprotect the sheet first.

As for the formatting...the easiest way would be to copy formatting from another cell that looks the way you want it to. For example, you can add the following lines to your code before you re-enable events:

ActiveSheet.Range("L2").Copy
'where L2 is a cell that is formatted the way you like.
target.PasteSpecial Paste:=xlPasteFormats
' Where target cell needs to be formatted.


alternatively, you could set the attributes of the cell specifically. For example.
target.Font.Underline = xlUnderlineStyleNone
target.Font.Color = vbblack

 

[kkorp]

Working Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Range("A4:A6")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
Application.EnableEvents = False
'Set the values to be uppercase
Target.Value = UCase(Target.Value)
'Set the HyperLink values
Target.Formula = "=HYPERLINK(""Product Support | Dell US" & Target.Value & "/overview"",""" & Target.Value & """)"
'Set Font Color
Target.Font.ColorIndex = 1
'Set Font Undeline
Target.Font.Underline = False
Application.EnableEvents = True
End Sub
;============================================================================================================