Advice to remove old code for a new code

I

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,832
Office Version
  1. 2007
Platform
  1. Windows
The code in use is shown below.
When i run the command button to send values from userform to worksheet the code automatically looks to see if a .jpg file exists in a specific folder.
If it does then the customers name is hyperlinked to it BUT if not the user is shown a msgbox advising THERE IS NO PHOTO etc etc.

After a while when no files need to be hyperlinked etc this Msgbox gets a litle pointles so i have added option buttons on my userform to take control.

Option Button 18 = YES & Option Button 19 = No

EaseUS_2024_08_12_10_06_16.jpg


So im looking to change the code so the YES / NO buttons take control but not sure what needs to be removed / added without breaking it / working
Basically stop the automatic check, So in future if YES is selected then do the Hyperlink part BUT if NO is selected just continue without the Msg part THERE IS NO PHOTO etc etc
Maybe the part in Red shpwn

Rich (BB 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 OptionButton8.Value = False And OptionButton9.Value = False And OptionButton10.Value = False And OptionButton14.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
    
    
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 OptionButton8.Value = True Then .Cells(lastRow + 1, 10).Value = "DHL": OptionButton8.Value = True
    If OptionButton9.Value = True Then .Cells(lastRow + 1, 10).Value = "MY HERMES": OptionButton9.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 OptionButton14.Value = True Then .Cells(lastRow + 1, 10).Value = "DPD": OptionButton14.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
        OptionButton8.Value = False
        OptionButton9.Value = False
        OptionButton10.Value = False
        OptionButton12.Value = False
        OptionButton13.Value = False
        OptionButton14.Value = False
        OptionButton15.Value = False
        OptionButton16.Value = False
        

        Application.Goto Sheets("POSTAGE").Range("B" & Rows.count).End(xlUp), True
        Call UserForm_Initialize
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"

        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

        NameForDateEntryBox.Clear
        UserForm_Initialize
        
        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

        
        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
        
        NameForDateEntryBox.Clear
        UserForm_Initialize
        End If
        
        End If
        End With

        End Sub
 

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
Sort by date Sort by votes
I have had a go at this but havent got far.
See code below.
Basically this is how it should work.

If OB 19 is true then hyperlink customers name in Column B
If OB18 is True then ignore the hyperlink part.

Currently i select OB18 & the code runs, hyperlinks customer fine.

My issue is when i select OB19, stratight away i see the MsgBox THERE IS NO PHOTO TO HYPERLINK FOR THIS CUSTOMER so ive tried to place the If in different places but getting confused.


VBA Code: 
        MsgBox "PLEASE SELECT A CUSTOMER FIRST TO HYPERLINK THE PHOTO.", vbCritical, "HYPERLINK ERROR MESSAGE"
        Exit Sub
        End If
        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
        End If
                              
        GoTo err
        End If

        If OptionButton19 = True Then
        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
        
        NameForDateEntryBox.Clear
        UserForm_Initialize
        End If
        End If
        
        End With

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

Similar threads

I
  • Question Question
Please explain this line of code
Replies
1
Views
172
RoryA
RoryA
I
  • Question Question
Find customer in column & link to his pdf
2
Replies
16
Views
655
NoSparks
N
I
  • Solved
Code moves worksheets columns to the left thus not showing column A
Replies
5
Views
203
Peter_SSs
Peter_SSs
D
  • Solved
Error 1004
2
Replies
18
Views
401
dmt32
D
I
  • Question Question
Listbox columns dont alter when i set the width advice please
Replies
6
Views
123
Skyybot
Skyybot

Forum statistics

Threads
1,224,811
Messages
6,181,081
Members
453,021
Latest member
Justyna P

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