Can you check my code please

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
3,637
Office Version
  1. 2007
Platform
  1. Windows
Hi,
Im going round in circles with a Compil Error End With Without With
Here is the code

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 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 OptionButton11.Value = False Then
    Cancel = 1
    MsgBox "You Must Select An Postal Company", 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 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
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, 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 = 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
    If OptionButton7.Value = True Then .Cells(lastrow + 1, 10).Value = "ROYAL MAIL": OptionButton7.Value = False
    If OptionButton8.Value = True Then .Cells(lastrow + 1, 10).Value = "DHL": OptionButton8.Value = False
    If OptionButton9.Value = True Then .Cells(lastrow + 1, 10).Value = "MY HERMES": OptionButton9.Value = False
    If OptionButton10.Value = True Then .Cells(lastrow + 1, 7).Value = "COLLECTION"
    If OptionButton10.Value = True Then .Cells(lastrow + 1, 10).Value = "COLLECTION": OptionButton10.Value = False
    If OptionButton11.Value = True Then .Cells(lastrow + 1, 10).Value = "N/A": OptionButton11.Value = False
    If OptionButton12.Value = True Then .Cells(lastrow + 1, 9).Value = "N/A": OptionButton12.Value = False
    If TextBox6.Value = "" Then .Cells(lastrow + 1, 4).Value = "NOTE"
    If TextBox6.Value = True Then
    
    With ActiveSheet.Cells(lastrow + 1, 4).Comment.Shape

        .Fill.ForeColor.RGB = RGB(255, 255, 255)
        .LINE.Weight = 1#
        
        With .TextFrame
            .AutoSize = True
            With .Characters
                With .Font
                    .Size = 12
                    .Name = "Calibri"
                    .Bold = True
                End With
            End With
        End With
    End With
    
Dim colorHTML As String, r As String, g As String, b As String
        If MsgBox("HAS THE SECURITY MARK BEEN APPLIED ?", vbYesNo + vbExclamation, "PINK SECURITY MARK MESSAGE") = vbYes Then
        TextBox1.Value = ""
        TextBox2.Value = ""
        TextBox3.Value = ""
        TextBox4.Value = ""
        TextBox6.Value = ""
        TextBox9.Value = ""
        .Cells(lastrow + 1, 11).Value = "YES"
        Application.ScreenUpdating = True

        

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
        

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, "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
        If MsgBox("THERE IS NO PHOTO TO HYPERLINK FOR THIS CUSTOMER" & vbCrLf & vbCrLf & _
        "WOULD YOU LIKE TO OPEN THE PHOTO FOLDER ?" & vbCrLf & vbCrLf & _
        "YES = OPEN THE PHOTO FOLDER" & vbCrLf & vbCrLf & _
        "NO = HYPERLINK IS NOT REQUIRED", vbYesNo + vbCritical, "HYPERLINK CUSTOMER MISSING PHOTO MESSAGE.") = vbYes Then
        
        CreateObject("Shell.Application").Open ("C:\Users\Ian\Desktop\REMOTES ETC\DR\EBAY CUSTOMERS PHOTOS\")
        MsgBox "CONTINUE TO NOW HYPERLINK CUSTOMER & PHOTO ?", vbInformation, "HYPERLINK PHOTO MESSAGE"
        
        GoTo err
        End If
End If

End With

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 Sub
 

Some videos you may like

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
3,637
Office Version
  1. 2007
Platform
  1. Windows
Well the honest answer is I dont know.
I think this was your way of trying to help me find the reason why i see the error biut im sorrecy im just confused now with it all
 

davesexcel

Well-known Member
Joined
Feb 26, 2006
Messages
1,018
Delete it.
When you have an opening "with" statement you need an "end with "
You have an "end with" without an opening "with"

The image shows where you have 4 With statements, with 4 End With

EDIT:Hold on, I see an opening with statement now
 
Last edited:

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
3,637
Office Version
  1. 2007
Platform
  1. Windows

ADVERTISEMENT

I did do that but ended up with Block If Without End If

This is why im going round in circles
 

davesexcel

Well-known Member
Joined
Feb 26, 2006
Messages
1,018
I found an open "If" statement, that has not been closed.

Probably once closed you will get a syntax error
Possibly it should not be an If, can't really have if msgbox as a msgbox displays a result.


1600278479215.png
 

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
3,637
Office Version
  1. 2007
Platform
  1. Windows

ADVERTISEMENT

Rich (BB code):
        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 ?" & vbCrLf & vbCrLf & _
        "YES = OPEN THE PHOTO FOLDER" & vbCrLf & vbCrLf & _
        "NO = HYPERLINK IS NOT REQUIRED", vbYesNo + vbCritical, "HYPERLINK CUSTOMER MISSING PHOTO MESSAGE.") = vbYes Then
        
        CreateObject("Shell.Application").Open ("C:\Users\Ian\Desktop\REMOTES ETC\DR\EBAY CUSTOMERS PHOTOS\")
        MsgBox "CONTINUE TO NOW HYPERLINK CUSTOMER & PHOTO ?", vbInformation, "HYPERLINK PHOTO MESSAGE"
        End If
        GoTo err
        End If
End If


TextBox1.Value = Format(CDbl(Date), "dd/mm/yyyy")

I added an End If as shown but then got a mewwage of expecting End With

I give up as this has been over 2 hours
 

davesexcel

Well-known Member
Joined
Feb 26, 2006
Messages
1,018
If you place your code here and hit the indent button, you will be able to line up your if/end if and with/end with, statements

 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
46,395
Office Version
  1. 365
Platform
  1. Windows
Try moving the final End With to between these two lines
VBA Code:
   If TextBox6.Value = "" Then .Cells(lastrow + 1, 4).Value = "NOTE"
    If TextBox6.Value = True Then
 

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
75,831
Office Version
  1. 365
Platform
  1. Windows
Try this.
VBA Code:
Private Sub PostageSheetTransferButton_Click()
Const FILE_PATH As String = "C:\Users\Ian\Desktop\REMOTES ETC\DR\EBAY CUSTOMERS PHOTOS\"
Dim i As Long
Dim x As Long
Dim ctrl As Control
Dim lastrow As Long
Dim colorHTML As String, r As String, g As String, b As String

    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.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 OptionButton11.Value = False Then
        Cancel = 1
        MsgBox "You Must Select An Postal Company", 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 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

    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, 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 = 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
        If OptionButton7.Value = True Then .Cells(lastrow + 1, 10).Value = "ROYAL MAIL": OptionButton7.Value = False
        If OptionButton8.Value = True Then .Cells(lastrow + 1, 10).Value = "DHL": OptionButton8.Value = False
        If OptionButton9.Value = True Then .Cells(lastrow + 1, 10).Value = "MY HERMES": OptionButton9.Value = False
        If OptionButton10.Value = True Then .Cells(lastrow + 1, 7).Value = "COLLECTION"
        If OptionButton10.Value = True Then .Cells(lastrow + 1, 10).Value = "COLLECTION": OptionButton10.Value = False
        If OptionButton11.Value = True Then .Cells(lastrow + 1, 10).Value = "N/A": OptionButton11.Value = False
        If OptionButton12.Value = True Then .Cells(lastrow + 1, 9).Value = "N/A": OptionButton12.Value = False
        If TextBox6.Value = "" Then .Cells(lastrow + 1, 4).Value = "NOTE"
        If TextBox6.Value = True Then

            With ActiveSheet.Cells(lastrow + 1, 4).Comment.Shape

                .Fill.ForeColor.RGB = RGB(255, 255, 255)
                .Line.Weight = 1#

                With .TextFrame
                    .AutoSize = True
                    With .Characters
                        With .Font
                            .Size = 12
                            .Name = "Calibri"
                            .Bold = True
                        End With
                    End With
                End With
            End With


            If MsgBox("HAS THE SECURITY MARK BEEN APPLIED ?", vbYesNo + vbExclamation, "PINK SECURITY MARK MESSAGE") = vbYes Then
                TextBox1.Value = ""
                TextBox2.Value = ""
                TextBox3.Value = ""
                TextBox4.Value = ""
                TextBox6.Value = ""
                TextBox9.Value = ""
                .Cells(lastrow + 1, 11).Value = "YES"
                Application.ScreenUpdating = True
            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
        End If

err:


        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
            If MsgBox("THERE IS NO PHOTO TO HYPERLINK FOR THIS CUSTOMER" & vbCrLf & vbCrLf & _
                      "WOULD YOU LIKE TO OPEN THE PHOTO FOLDER ?" & vbCrLf & vbCrLf & _
                      "YES = OPEN THE PHOTO FOLDER" & vbCrLf & vbCrLf & _
                      "NO = HYPERLINK IS NOT REQUIRED", vbYesNo + vbCritical, "HYPERLINK CUSTOMER MISSING PHOTO MESSAGE.") = vbYes Then

                CreateObject("Shell.Application").Open ("C:\Users\Ian\Desktop\REMOTES ETC\DR\EBAY CUSTOMERS PHOTOS\")
                MsgBox "CONTINUE TO NOW HYPERLINK CUSTOMER & PHOTO ?", vbInformation, "HYPERLINK PHOTO MESSAGE"

                GoTo err
            End If
        End If

    End With

    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 Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,109,087
Messages
5,526,767
Members
409,720
Latest member
Antwain

This Week's Hot Topics

Top