Posts by CowFarmer

CowFarmer · Aug 22nd 2022

JD,

Thanks for your help!

I've attached an example spreadsheet. I've set it up similarly to how I have my actual document. The sheet I wish to apply the code to is the result of a query (in this case Sheet3).

Your code above works on a standard table but results in a type mismatch error when refreshing the table constructed from a query on line 2: "If Target.Value2 = vbNullString Then GoTo Exit_Sub".

Also, I'm trying to avoid applying the link to the first row since that's the header row. I tried starting the range at A2 and C2 but it also resulted in errors.

CowFarmer · Aug 19th 2022

JD,

Thanks for the help! I've tried both of your code examples. The first is giving me a Type Mismatch on line 6: str = Target.Value2.

The second version works, however it loops through my entire worksheet column by column and applies link apath and cpath to every column (i.e. aPath applied to column 1,3,5,7 etc. and cPath to 2.4.6.8 etc).

I only need to apply links to columns A and C. Also, my code example range starts a row 2 due to headers.

CowFarmer · Aug 18th 2022

Ok, I think I may have figured it out for the most part. The links are immediately available in column A, however the column C links require clicking in the cell then off the cell to activate the link. What am I missing?

Code

Private Sub Worksheet_Change(ByVal Target As Range)

Dim cPart As String
Dim pPart As String
Dim cMyTarget As Range, c As Range
Dim pMyTarget As Range, p As Range
maxrow1 = Range ("A" & Rows.Count).End(xlUp).Row
maxrow2 = Range ("C" & Rows.Count).End(xlUp).Row
Const cPath = "http://myurl.default.asp?PopUp1" 
Const pPath = "http://myurl.default.asp?PopUp2" 

Set cMyTarget = Intersect(Target, Range("A2:A" & maxrow1))
Set pMyTarget = Intersect(Target, Range("C2:C" & maxrow2))

If Not cMyTarget Is Nothing Then 
    For Each c In cMyTarget
        On Error GoTo CleanUp
        Application.EnableEvents = False
        cPart = c.Text
        If cPart = "" Then
            '---delete existing hyperlink if any
            If c.Hyperlinks.Count > 0 Then c.Hyperlinks(1).Delete
        Else
            Me.Hyperlinks.Add _
                Anchor:=c, Address:=cPath & c.Text, _
                TextToDisplay:=c.Text
        End If
    Next c
Application.EnableEvents = True

ElseIf Not pMyTarget Is Nothing Then 
    For Each p In pMyTarget
        On Error GoTo CleanUp
        Application.EnableEvents = False
        pPart = p.Text
        If pPart = "" Then
            '---delete existing hyperlink if any
            If p.Hyperlinks.Count > 0 Then p.Hyperlinks(1).Delete
        Else
            Me.Hyperlinks.Add _
                Anchor:=p, Address:=pPath & p.Text, _
                TextToDisplay:=p.Text
        End If
    Next p
End If
CleanUp:
    Application.EnableEvents = True
End Sub

Display More

CowFarmer · Aug 17th 2022

I have code that takes the value of a cells in a single column and then uses that value to create a hyperlink within that same cell. It works with the code below. However I'm at a loss to do the same thing with two different columns on the same worksheet. The code below converts the value in column A into a hyperlink. I want to do the same to column C on the same worksheet but with a different hyperlink. I've tried unsuccessfully by adding a new section of code with a new range for column C. I also attempted to add both columns in the code below with additional variables. I haven't done much VBA coding. Any assistance would be much appreciated.

Code

Private Sub Worksheet_Change(ByVal Target As Range)

Dim sPart As String
Dim rMyTarget As Range, c As Range
maxrow = Range ("A" & Rows.Count).End(xlUp).Row
Const sPath = "http://myurl.default.asp?PopUp" 

Set rMyTarget = Intersect(Target, Range("A2:A" & maxrow))
If rMyTarget Is Nothing Then Exit Sub
For Each c In rMyTarget
    On Error GoTo CleanUp
    Application.EnableEvents = False
    sPart = c.Text
    If sPart = "" Then
        '---delete existing hyperlink if any
        If c.Hyperlinks.Count > 0 Then c.Hyperlinks(1).Delete
    Else
        Me.Hyperlinks.Add _
            Anchor:=c, Address:=sPath & c.Text, _
            TextToDisplay:=c.Text
    End If
Next c
CleanUp:
    Application.EnableEvents = True
End Sub

Display More

Posts by CowFarmer

Use cell values to create hyperlinks using VBA Worksheet_Change Event

Use cell values to create hyperlinks using VBA Worksheet_Change Event

Use cell values to create hyperlinks using VBA Worksheet_Change Event

Use cell values to create hyperlinks using VBA Worksheet_Change Event