Vba has stopped adding hyperlink to my customers name

I

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,731
Office Version
  1. 2007
Platform
  1. Windows
I have a userform & the values a sent to the worksheet.
In column B will be the customers name.
The code would hyperlink this customers name if a photo was present in the advised folder & if not it would show the user a message advising no photo is present etc.

I have just seen that this no longer works.
I have a separate code on worksheet where i select the customer & add the hyperlink that way so that shows the path etc is correct.

Not sure how much of the code you need but this i believe is after the values are sent to worksheet, not sure if that shows an issue there for you ?

VBA Code: 
        Const FILE_PATH As String = "C:\Users\Ian\Desktop\REMOTES ETC\DR\EBAY CUSTOMERS PHOTOS\"
        If ActiveCell.Column = Columns("B").Column Then
 
        If Len(Dir(FILE_PATH & ActiveCell.Value & ".jpg")) Then
          ActiveCell.Hyperlinks.Add Anchor:=ActiveCell, Address:=FILE_PATH & ActiveCell.Value & ".jpg"
        MsgBox "CUSTOMER PHOTO HYPERLINK WAS SUCCESSFUL.", vbInformation, "SUCCESSFUL HYPERLINK MESSAGE"

        End If
        Else
            MsgBox "PLEASE SELECT A CUSTOMER FIRST TO HYPERLINK THE PHOTO.", vbCritical, "HYPERLINK ERROR MESSAGE"
        Exit Sub
        End If
        
        If Dir(FILE_PATH & ActiveCell.Value & ".jpg") = "" Then
        
        If MsgBox("THERE IS NO PHOTO TO HYPERLINK FOR THIS CUSTOMER" & vbCrLf & vbCrLf & _
            "WOULD YOU LIKE TO OPEN THE PHOTO FOLDER ?", vbYesNo + vbInformation, "HYPERLINK MISSING PHOTO MESSAGE.") = vbYes Then
        
            CreateObject("Shell.Application").Open ("C:\Users\Ian\Desktop\REMOTES ETC\DR\EBAY CUSTOMERS PHOTOS\")
            answer = MsgBox("CONTINUE TO NOW HYPERLINK THE CUSTOMER WITH PHOTO ?", vbYesNo, "HYPERLINK PHOTO MESSAGE")
        If answer = vbNo Then
        Exit Sub
        Else
                                            
        GoTo err
        End If
        End If
        End If
        End If
        
        End Sub

I have an old file where ive just tried it & it works.
There is redundant code in it that i no longer use so not sure how to go about going through it to locate the issue
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Sort by date Sort by votes
This is the fill code on the command button.

On the code shown in Red i added a Msgbox but when i read the code BOTH were ignored.
So this is why when OB19 is selected YES nothing happens.

Does that mean the issie lies above ?

VBA Code: 
Private Sub PostageSheetTransferButton_Click()

Cancel = 0
If TextBox2.Text = "" Then
    Cancel = 1
    MsgBox "CUSTOMER`S NAME NOT ENTERED", vbCritical, "POSTAGE TRANSFER SHEET"
    TextBox2.SetFocus
    
ElseIf TextBox3.Text = "" Then
    Cancel = 1
    MsgBox "ITEM DESCRIPTION NOT ENTERED", vbCritical, "POSTAGE TRANSFER SHEET"
    TextBox3.SetFocus
    
ElseIf OptionButton15.Value = False And OptionButton16.Value = False Then
    Cancel = 1
    MsgBox "SECURITY QUESTION NOT ANSWERED", vbCritical, "POSTAGE TRANSFER SHEET"
    
ElseIf OptionButton12.Value = False And OptionButton13.Value = False Then
    Cancel = 1
    MsgBox "YOU MUST SELECT A USER NAME OPTION", vbCritical, "POSTAGE TRANSFER SHEET"
    
ElseIf TextBox9.Visible = True And TextBox9.Text = "" Then
    Cancel = 1
    MsgBox "EBAY USERNAME NOT ENTERED", vbCritical, "POSTAGE TRANSFER SHEET"
    TextBox9.SetFocus
    
ElseIf TextBox4.Visible = True And TextBox4.Text = "" Then
    Cancel = 1
    MsgBox "TRACKING NUMBER NOT ENTERED", vbCritical, "POSTAGE TRANSFER SHEET"
    TextBox4.SetFocus
    
ElseIf OptionButton1.Value = False And OptionButton2.Value = False And OptionButton3.Value = False Then
    Cancel = 1
    MsgBox "You Must Select An Ebay Account", vbCritical, "POSTAGE TRANSFER SHEET"
    
ElseIf OptionButton4.Value = False And OptionButton5.Value = False And OptionButton6.Value = False Then
    Cancel = 1
    MsgBox "You Must Select An Origin", vbCritical, "POSTAGE TRANSFER SHEET"
    
ElseIf OptionButton7.Value = False And OptionButton10.Value = False And OptionButton17.Value = False Then
    Cancel = 1
    MsgBox "You Must Select An Postal Company", vbCritical, "POSTAGE TRANSFER SHEET"
        
ElseIf OptionButton13.Value = True And TextBox9.Value = "" Then
    Cancel = 1
    MsgBox "YOU MUST ENTER A EBAY USER NAME", vbCritical, "POSTAGE TRANSFER SHEET"
    TextBox9.SetFocus
    
ElseIf OptionButton18.Value = False And OptionButton19.Value = False Then
    Cancel = 1
    MsgBox "HYPERLINK PHOTO QUESTION NOT ANSWERED", vbCritical, "POSTAGE TRANSFER SHEET"
    
End If



If Cancel = 1 Then
        Exit Sub
End If

Dim i As Long
Dim x As Long
Dim ctrl As Control
Dim LastRow As Long
Dim LArea As Long
Dim xShape As Shape
Dim Mycomments As Variant
Dim answer As Integer


LastRow = ThisWorkbook.Worksheets("POSTAGE").Cells(Rows.count, 1).End(xlUp).Row
    
On Error Resume Next
    
 With ThisWorkbook.Worksheets("POSTAGE")
    .Cells(LastRow + 1, 1).Value = TextBox1.Text
    .Cells(LastRow + 1, 2).Value = TextBox2.Text
    .Cells(LastRow + 1, 3).Value = TextBox3.Text
    .Cells(LastRow + 1, 5).Value = TextBox4.Text
    .Cells(LastRow + 1, 4).Value = TextBox6.Text
    .Cells(LastRow + 1, 9).Value = TextBox9.Text
    .Cells(LastRow + 1, 7).Value = "POSTED"
    .Cells(LastRow + 1, 4).NoteText Text:=TextBox10.Text
    
    If OptionButton1.Value = True Then .Cells(LastRow + 1, 8).Value = "DR": OptionButton1.Value = True
    If OptionButton2.Value = True Then .Cells(LastRow + 1, 8).Value = "IVY": OptionButton2.Value = True
    If OptionButton3.Value = True Then .Cells(LastRow + 1, 8).Value = "N/A": OptionButton3.Value = True
    If OptionButton4.Value = True Then .Cells(LastRow + 1, 6).Value = "EBAY": OptionButton4.Value = True
    If OptionButton5.Value = True Then .Cells(LastRow + 1, 6).Value = "WEB SITE": OptionButton5.Value = True
    If OptionButton6.Value = True Then .Cells(LastRow + 1, 6).Value = "N/A": OptionButton6.Value = True
    If OptionButton7.Value = True Then .Cells(LastRow + 1, 10).Value = "ROYAL MAIL": OptionButton7.Value = True
    If OptionButton10.Value = True Then .Cells(LastRow + 1, 7).Value = "COLLECTION"
    If OptionButton10.Value = True Then .Cells(LastRow + 1, 10).Value = "COLLECTION": OptionButton10.Value = True
    If OptionButton12.Value = True Then .Cells(LastRow + 1, 9).Value = "N/A": OptionButton12.Value = True
    If OptionButton15.Value = True Then .Cells(LastRow + 1, 11).Value = "YES": OptionButton15.Value = True
    If OptionButton16.Value = True Then .Cells(LastRow + 1, 11).Value = "NO": OptionButton16.Value = True
    If OptionButton17.Value = True Then .Cells(LastRow + 1, 10).Value = "EVRI": OptionButton17.Value = True
    
On Error Resume Next
        
With ThisWorkbook.Worksheets("POSTAGE").Cells(LastRow + 1, 4).Comment
        .Shape.Autoshapetype = msoShapeRoundedRectangle
        .Shape.TextFrame.Characters.Font.NAME = "Times Roman" ' FONT FAMILY STYLE
        .Shape.TextFrame.Characters.Font.Size = 12 ' TEXT SIZE
        .Shape.TextFrame.Characters.Font.ColorIndex = 5 ' TEXT COLOR
        .Shape.LINE.ForeColor.RGB = RGB(0, 0, 0) ' ARROW & LINE COLOR
        .Shape.Fill.Visible = msoTrue
        .Shape.Fill.ForeColor.RGB = RGB(255, 255, 255) ' FILL COLOR
        .Shape.TextFrame.AutoSize = True
        
    End With
On Error GoTo 0

Dim colorHTML As String, r As String, g As String, b As String

        TextBox2.Value = ""
        TextBox3.Value = ""
        TextBox4.Value = ""
        TextBox6.Value = ""
        TextBox9.Value = ""
        TextBox10.Value = ""
        Application.ScreenUpdating = True
        OptionButton1.Value = False
        OptionButton2.Value = False
        OptionButton3.Value = False
        OptionButton4.Value = False
        OptionButton5.Value = False
        OptionButton6.Value = False
        OptionButton7.Value = False
        OptionButton10.Value = False
        OptionButton12.Value = False
        OptionButton13.Value = False
        OptionButton15.Value = False
        OptionButton16.Value = False
        OptionButton18.Value = False
        OptionButton19.Value = False
        

        Application.GoTo Sheets("POSTAGE").Range("B" & Rows.count).End(xlUp), True
        Call UserForm_Initialize
                
        If Worksheets("POSTAGE").Cells(LastRow + 1, 11).Value = "" Then MsgBox "THERE ISNT A YES / NO VALUE IN SECURITY CELL", vbCritical, "SECURITY MESSAGE"
  
        TextBox1.Value = Format(CDbl(Date), "dd/mm/yyyy")
        TextBox1.Value = Now
        TextBox1.Value = Format(CDbl(Date), "dd/mm/yyyy")
        TextBox2.Value = ""
        TextBox3.Value = ""
        TextBox4.Value = ""
        TextBox6.Value = ""
        TextBox9.Value = ""
        TextBox10.Value = ""
        TextBox2.SetFocus
        
        ListBox2.Clear
        UserForm_Initialize
        End With
 
[COLOR=rgb(184, 49, 47)]        If OptionButton19 = True Then
        Exit Sub
        End If
        
        If OptionButton18 = True Then[/COLOR]
              
err:
        Const FILE_PATH As String = "C:\Users\Ian\Desktop\REMOTES ETC\DR\EBAY CUSTOMERS PHOTOS\"
        If ActiveCell.Column = Columns("B").Column Then
 
        If Len(Dir(FILE_PATH & ActiveCell.Value & ".jpg")) Then
          ActiveCell.Hyperlinks.Add Anchor:=ActiveCell, Address:=FILE_PATH & ActiveCell.Value & ".jpg"
        MsgBox "CUSTOMER PHOTO HYPERLINK WAS SUCCESSFUL.", vbInformation, "SUCCESSFUL HYPERLINK MESSAGE"

        End If
        Else
            MsgBox "PLEASE SELECT A CUSTOMER FIRST TO HYPERLINK THE PHOTO.", vbCritical, "HYPERLINK ERROR MESSAGE"
        Exit Sub
        End If
        
        If Dir(FILE_PATH & ActiveCell.Value & ".jpg") = "" Then
        
        If MsgBox("THERE IS NO PHOTO TO HYPERLINK FOR THIS CUSTOMER" & vbCrLf & vbCrLf & _
            "WOULD YOU LIKE TO OPEN THE PHOTO FOLDER ?", vbYesNo + vbInformation, "HYPERLINK MISSING PHOTO MESSAGE.") = vbYes Then
        
            CreateObject("Shell.Application").Open ("C:\Users\Ian\Desktop\REMOTES ETC\DR\EBAY CUSTOMERS PHOTOS\")
            answer = MsgBox("CONTINUE TO NOW HYPERLINK THE CUSTOMER WITH PHOTO ?", vbYesNo, "HYPERLINK PHOTO MESSAGE")
        If answer = vbNo Then
        Exit Sub
        Else
                                            
        GoTo err
        End If
        End If
        End If
        End If
        
        End Sub
 
Upvote 0
Here is a test file if you could take a look please

TEST FILE DOWNLOAD

Top left of worksheet select OPEN FORM
Complete the fields etc & make sure you select YES to PHOTO HYPERLINK.
Once done select POSTAGE SHEET TRANSFER BUTTON.

Now on my pc if the photo file is missing ftrom the folder or spelt wrong you should see a message to advise you.
I no longer see this message.

If photo is present & spelt correctly etc then close the form & the customer in question should have been selected in column B of the last row & its hyperlink to the photo applied.
This no longer happens

Many Thanks.
 
Upvote 0
So i found the issue & now need some advice please on how to correctly write it.

The issue is this piece of code.

VBA Code: 
        If OptionButton19 = True Then
        Exit Sub
        End If
        
        If OptionButton18 = True Then

On my userform i have OptionBUtton18 which is labeled YES & OptionButton19 which is labeled NO
This relates to whether there is a photo to hyperlink to the customer in question.

The existing code i thought worked like so.
If OptionButton19 "NO" = True/Selected then there is no photo to hyperlink so just continue.

If OptionButton18 "YES" = True/Selected then there is a photo to hyperlink so continue with the hyperlink code below.

Basically i deleted the code shown above in this post & hyperlink worked fine.

What i do notice is if there isnt a photo to hyperlink i have no way of advising the code that as i deleted it & thus because a photo isnt present in the path to photo folder i then see Msgbox advising no photo found.

So please advise how i write it correctly the OptionButton Yes / No part

Thanks
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Question Question
Added new code but keep seeing Block If Without End If Mesage
Replies
3
Views
143
RoryA
RoryA
I
  • Question Question
Advice to remove old code for a new code
Replies
2
Views
201
ipbr21054
I
I
  • Solved
Add date to worksheet when userform is closed
Replies
5
Views
112
ipbr21054
I
I
  • Solved
Hyperlink customer in another workbook to a file
2
Replies
11
Views
464
ipbr21054
I
I
  • Question Question
Check if file extsts before continue
Replies
5
Views
403
ipbr21054
I

Forum statistics

Threads
1,223,877
Messages
6,175,138
Members
452,614
Latest member
MRSWIN2709

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top