can you advise on my code please

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,226
Office Version
  1. 2007
Platform
  1. Windows
Hi,
Supplied is the working code in use.

The item in red in my code gets to the point of the msgbox WOULD YOU LIKE TO OPEN THE PHOTO FOLDER ?
If you select NO in continues & does what its supposed to soall is ok there.

BUT

If you select YES you are taken to the folder no problem BUT when you close the folder down then the code has continued to add the values to the worksheer & also clearing the userform.
Can you advise please what i should do so if YES is selected the code doesnt contine so i can then open the folder,do what i need to do then once the folder is closed i still have the userform with values in from of me.

Thanks





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 TextBox4.Text = "" Then
    Cancel = 1
    MsgBox "Tracking Number Not Entered", vbCritical, "POSTAGE TRANSFER SHEET"
    TextBox4.SetFocus
ElseIf ComboBox1.Text = "" Then
    Cancel = 1
    MsgBox "Username Not Entered", vbCritical, "POSTAGE TRANSFER SHEET"
    ComboBox1.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"
    
    
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
LastRow = ThisWorkbook.Worksheets("POSTAGE").Cells(Rows.Count, 1).End(xlUp).Row
    

    
 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, 9).Value = ComboBox1.Text
    .Cells(LastRow + 1, 4).Value = TextBox6.Text
    .Cells(LastRow + 1, 7).Interior.Color = RGB(255, 0, 0)
    .Cells(LastRow + 1, 7).Value = "POSTED"
    If OptionButton1.Value = True Then .Cells(LastRow + 1, 8).Value = "DR": OptionButton1.Value = False
    If OptionButton2.Value = True Then .Cells(LastRow + 1, 8).Value = "IVY": OptionButton2.Value = False
    If OptionButton3.Value = True Then .Cells(LastRow + 1, 8).Value = "N/A": OptionButton3.Value = False
    If OptionButton4.Value = True Then .Cells(LastRow + 1, 6).Value = "EBAY": OptionButton4.Value = False
    If OptionButton5.Value = True Then .Cells(LastRow + 1, 6).Value = "WEB SITE": OptionButton5.Value = False
    If OptionButton6.Value = True Then .Cells(LastRow + 1, 6).Value = "N/A": OptionButton6.Value = False
    
Dim colorHTML As String, r As String, g As String, b As String
        If MsgBox("HAS THE SECURITY MARK BEEN APPLIED ?", vbYesNo + vbExclamation, "PINK LIPSTICK SECURITY MESSAGE") = vbYes Then
        TextBox1.Value = ""
        TextBox2.Value = ""
        TextBox3.Value = ""
        TextBox4.Value = ""
        TextBox6.Value = ""
        ComboBox1.Value = ""
        
            colorHTML = "FF0099"
            r = WorksheetFunction.Hex2Dec(Left(colorHTML, 2))
            g = WorksheetFunction.Hex2Dec(Mid(colorHTML, 3, 2))
            b = WorksheetFunction.Hex2Dec(Right(colorHTML, 2))
            .Cells(LastRow + 1, 4).Interior.Color = RGB(r, g, b)
End If
        MsgBox "CUSTOMER POSTAGE SHEET HAS NOW BEEN UPDATED", vbInformation, "SUCCESSFUL UPDATE MESSAGE"
        Application.Goto Sheets("POSTAGE").Range("B" & Rows.Count).End(xlUp), True


 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, "POSTAGE SHEET HYPERLINK MESSAGE"
        End If
        
        Else
        MsgBox "PLEASE SELECT A CUSTOMER FIRST TO HYPERLINK THE PHOTO.", vbCritical, "POSTAGE SHEET HYPERLINK MESSAGE"
        Exit Sub
        End If
        
        If Dir(FILE_PATH & ActiveCell.Value & ".jpg") = "" Then
[COLOR=rgb(184, 49, 47)]        If MsgBox("THERE IS NO PHOTO TO HYPERLINK FOR THIS CUSTOMER" & vbNewLine & "WOULD YOU LIKE TO OPEN THE PHOTO FOLDER ?", vbYesNo + vbCritical, "HYPERLINK CUSTOMER MISSING PHOTO MESSAGE.") = vbYes Then[/COLOR]
        
        CreateObject("Shell.Application").Open ("C:\Users\Ian\Desktop\REMOTES ETC\DR\EBAY CUSTOMERS PHOTOS\")
        End If

    
    End If

End With
    
TextBox1.Value = Format(CDbl(Date), "dd/mm/yyyy")
TextBox2.SetFocus
TextBox1.Value = Now
TextBox1.Value = Format(CDbl(Date), "dd/mm/yyyy")
Unload PostageTransferSheet
PostageTransferSheet.Show
End Sub
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
so if im understanding correctly you want to exit the the sub if someone clicks yes?
what you can do is an if statement where if vbyes = true then hide the userform and exit the sub, but how would you want someone to resume using the userform?
 
Upvote 0
Hi
I don’t want to hide it I just don’t want the code to continue is YES was selected.
Once the photo folder has been open I then correct my spelling mistake etc I would then close the photo folder. Now I should be looking at the userform where it’s expecting me to the continue.
 
Upvote 0
I don’t want to hide it I just don’t want the code to continue is YES was selected.

well it IS continuing when yes is selected the only thing is its not waiting for your change to the spelling
after hitting yes it will still do these steps

VBA Code:
TextBox1.Value = Format(CDbl(Date), "dd/mm/yyyy")
TextBox2.SetFocus
TextBox1.Value = Now
TextBox1.Value = Format(CDbl(Date), "dd/mm/yyyy")
Unload PostageTransferSheet
PostageTransferSheet.Show

but you said you want to keep the userform?
i don't have your userform so i can't tell where you want to continue from but essentially before you were given the option for this message box?
 
Upvote 0
below

VBA Code:
CreateObject("Shell.Application").Open ("C:\Users\Ian\Desktop\REMOTES ETC\DR\EBAY CUSTOMERS PHOTOS\")

add

VBA Code:
CreateObject("Shell.Application").Open ("C:\Users\Ian\Desktop\REMOTES ETC\DR\EBAY CUSTOMERS PHOTOS\")
goto err

and above

VBA Code:
 If Len(Dir(FILE_PATH & ActiveCell.Value & ".jpg")) Then

add
VBA Code:
err:
 If Len(Dir(FILE_PATH & ActiveCell.Value & ".jpg")) Then

this is obviously untested but i think its what you want to happen
 
Upvote 0
Hi
When I wrote is it should of been if.
I understand it’s continuing once YES is selected.
What’s happens is this.
I put a photo in the photo folder.
Let’s call it TOM JONES 001

When I’m in the userform and entering data for this customer I hyperlink the customers name in my first Textbox to the photo in the folder.
It is at this point I am told NO PHOTO FOE RHIS CUSTOMER.
I select YES to open the photo folder to then see that I made a spelling mistake say TOOM JONES 001 which is why the hyperlink didn’t work.
I correct the spelling mistake & close the photo folder.
Now when I come back to the userform I want to retry adding the hyperlink.
So yes to pausing the code running.
 
Upvote 0
oh okay then add another messagebox after the folder is opened and combine that method with my previous one

VBA Code:
CreateObject("Shell.Application").Open ("C:\Users\Ian\Desktop\REMOTES ETC\DR\EBAY CUSTOMERS PHOTOS\")
msgbox "Click here when you are done naming things"
goto err

put "err:"
in the point of your code that you want it to reset to which i assume is
VBA Code:
err:
 Const FILE_PATH As String = "C:\Users\Ian\Desktop\REMOTES ETC\DR\EBAY CUSTOMERS PHOTOS\"
 
Upvote 0
note this would be an entirely different beast if you wanted to pause the macro to fix a spelling mistake within the workbook.
 
Upvote 0
It was an explanation as to why I want the code to stop running and here’s why.

When the codes continues and I then look at the worksheet there isn’t a hyperlink applied.
So hence this post.
 
Upvote 0
It was an explanation as to why I want the code to stop running and here’s why.

When the codes continues and I then look at the worksheet there isn’t a hyperlink applied.
So hence this post.

did my solution work?
i can't personally test it
 
Upvote 0

Forum statistics

Threads
1,214,920
Messages
6,122,279
Members
449,075
Latest member
staticfluids

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