Worksheet_Change(ByVal Target As Range)

navic

New member
Joined
Aug 27, 2013
Messages
901
Reaction score
0
Points
0
Excel Version(s)
Excel 2013
I wish that in column A, by entering the number and after pressing the Enter key to Excel automatically creating a hyperlink to the respective worksheet in the same workbook
Can this be done via VBA and events Change

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
.........code for hyperlink..........
End Sub
 

Attachments

  • example.xlsm
    13.8 KB · Views: 32
Presumably you want to go to A1 on the sheet
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim oSht As Worksheet
    If Target.Column = 1 Then                                                   'ignore if other column
    
        For Each oSht In ActiveWorkbook.Sheets
            If InStr(oSht.Name, Target.Value) = 1 Then                          'find the sheet
                If Target.Hyperlinks.Count > 0 Then Target.Hyperlinks.Delete    'delete any that are there already
                    ActiveSheet.Hyperlinks.Add Anchor:=Target.Cells(1, 1), Address:="", SubAddress:="'" & oSht.Name & "'!A1"
                    
                Exit For
            End If
        Next
    
    End If
End Sub
 
Thanks WizzardOfO
This is perfect, but

Please, can you set a specific range within the VBA code.
In this way, the VBA has full column A
I want to specify a specific range of cells in column A

eg. Range A1:A10 and A15:A30, the range should be a hyperlink, the other cells in column A should be free

Sometime I need range A2:A10 and J2:J10
I need VBA that I can self-edit to my needs

[EDIT]:
I have a problem when I delete numbered hyperlink, there appears hyperlinking "Sheet1!A1". I just can not delete the hyperlink?
 
Last edited:
sorry only seen this just before shutting down. you can try something along the lines of
If not intersect(Target, Range("A1:A10,B2,C5: C10")) Is Nothing instead of target.column
otherwise play with (target.column = 1 and target.row >2 and target.row <10) or (target.column = 5 and target.row >2 and target.row <10)

the code should be deleting the old hyper link and immediately re linking to the new address run through with debug to test this
 
Last edited:
Thanks,
Sorry but I do not know to implement
Can you set up a new VBA code with changes(for my example)

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim oSht As Worksheet
'    If Target.Column = 1 Then 'column for hyperlink, ignore if other column
     If not intersect(Target, Range("A1:A10,J2:J10")) Is Nothing
        For Each oSht In ActiveWorkbook.Sheets
            If InStr(oSht.Name, Target.Value) = 1 Then 'find the sheet
                If Target.Hyperlinks.Count > 0 Then Target.Hyperlinks.Delete  'delete any that are there already
                    ActiveSheet.Hyperlinks.Add Anchor:=Target.Cells(1, 1), Address:="", SubAddress:="'" & oSht.Name & "'!A1"
                    
                Exit For
            End If
        Next
    
    End If
End Sub
 
You are lucky I'm not like some of the other grumpy buggers here :)

Thanks,
Sorry but I do not know to implement
Can you set up a new VBA code with changes(for my example)

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim oSht As Worksheet
'    If Target.Column = 1 Then 'column for hyperlink, ignore if other column
     If not intersect(Target, Range("A1:A10,J2:J10")) Is Nothing [COLOR=#ff0000][B]THEN[/B][/COLOR]
        For Each oSht In ActiveWorkbook.Sheets
            If InStr(oSht.Name, Target.Value) = 1 Then 'find the sheet
                If Target.Hyperlinks.Count > 0 Then Target.Hyperlinks.Delete  'delete any that are there already
                    ActiveSheet.Hyperlinks.Add Anchor:=Target.Cells(1, 1), Address:="", SubAddress:="'" & oSht.Name & "'!A1"
                    
                Exit For
            End If
        Next
    
    End If
End Sub
 
Thank you, you're a man who wants to help, the forum is a place where members can ask for help.
But, again, I have a problem when I delete a hyperlink. Excel we report an error "Run-time error '1004'." Also in the cell, after deleting the hyperlink appears 'Sheet1'! A1
In the VBE lines of code that contains the range is highlighted in yellow

Please see attach, Thank you for your time in advance
 

Attachments

  • example2.xlsm
    20.9 KB · Views: 20
No worries, I try ignore the politics.

I'm not getting an error with your file, obviously something in the settings but some funny font stuff going along.
Minor change to ignore empty cells.
Replace the code then select Column A and J and right-click and remove hyperlinks then Format cells, font, click normal font

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim oSht As Worksheet
'    If Target.Column = 1 Then 'column for hyperlink, ignore if other column
[COLOR=#ff0000][B]     If Not (IsEmpty(Target.Value2) Or (Intersect(Target, Range("A1:A10,J2:J10")) Is Nothing)) Then[/B][/COLOR]
        For Each oSht In ActiveWorkbook.Sheets
            If InStr(oSht.Name, Target.Value) = 1 Then 'find the sheet
                If Target.Hyperlinks.Count > 0 Then Target.Hyperlinks.Delete  'delete any that are there already
                    ActiveSheet.Hyperlinks.Add Anchor:=Target.Cells(1, 1), Address:="", SubAddress:="'" & oSht.Name & "'!A1"
                    
                Exit For
            End If
        Next
    
    End If
End Sub
 
This is great
Thank you so much man
 
Back
Top