End the VBA from running

Romano_odK

Romano_odK

Active Member
Joined
Jun 4, 2020
Messages
379
Office Version
  1. 365
Platform
  1. Windows
Good afternoon,

Got a bit of code and this code gives me a warning if condition are not met, but what it doesn't do is stop the macro. How can I accomplish that? First I thought with Exit Sub, but that didn't work or I placed it wrong.

Thank you for you time,

Romano

Action = True
If Worksheets("A100").Cells(2, 1) = Empty Then
MsgBox ("Dag niet gevuld")
Action = False
End If
If Worksheets("A100").Cells(3, 1) = Empty Then
MsgBox ("Maand niet gevuld")
Action = False
End If
If Worksheets("A100").Cells(4, 1) = Empty Then
MsgBox ("Jaar niet gevuld")
Action = False
End If
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
Sort by date Sort by votes
I am not seeing any "Exit Sub" lines in your code.
That is what you would add if you want to quit the VBA code right at that point.

However, bear in mind that if this VBA procedure is being called by another VBA procedure, it will bail out of the current procedure, but keep on going in the parent procedure, unless you code it to bail out of that one too.
 
Upvote 0
You can put Exit Subjust before each End If
 
Upvote 0
Joe4 said:
I am not seeing any "Exit Sub" lines in your code.
That is what you would add if you want to quit the VBA code right at that point.

However, bear in mind that if this VBA procedure is being called by another VBA procedure, it will bail out of the current procedure, but keep on going in the parent procedure, unless you code it to bail out of that one too.
Click to expand...
Good evening,

Thank you for your reply. I think you are right. I added the Exit Sub, but it doesn't work. The file is still being written and that's just want I am trying to prevent. Do you understand this code enough to tell me how to stop the macro from continuing? I will add the whole macro below.

Thank you in advance.


VBA Code: 
'   ----------------------------------------------------------------------------------------
'   IDENTIFICATION DIVISION
'

'   ----------------------------------------------------------------------------------------
'   DATA DIVISION
  
    Public Itemcode                As String
    Public SalesPrice              As String
    Public CostPrice               As String
    Public SupplierMain            As String
    Public SupplierCode            As String
    Public SupplierPrice           As String
            
    Public Itemrow          As Integer   ' Counter for actual row
    Public SaveDir          As String    ' Header Cell (2,2)
    Public ItemCurrency     As String    ' Header Cell (4,2)
    Public ItemResource     As String    ' Header Cell (6,2)
    Public Action           As Boolean   ' Flag
Private Function Conversion(ByVal InputString As String) As String

Dim ASCII As Integer
Conversion = ""
While Len(InputString) > 0
ASCII = AscW(Left(InputString, 1))

Select Case ASCII
Case 1 To 9999 '47, 58 To 64, 91 To 96, 123 To 235
Conversion = Conversion & "&#" & ASCII & ";"
Case Else
Conversion = Conversion & Left(InputString, 1)
End Select

InputString = Right(InputString, Len(InputString) - 1)
' ,"ø","ø")
Wend
End Function
Sub ConvertCostpriceToXML()
'   ----------------------------------------------------------------------------------------
'   Create output file as an object in the system with the file name as stated in the SaveDir variable
'   If this file exists, it will be overwritten without questions asked
    SaveDir = Worksheets("A100").Cells(2, 35)
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set a = fs.CreateTextFile("" & SaveDir & "", True)
'   ----------------------------------------------------------------------------------------
'   Write xml header
    a.writeline ("<?xml version=""1.0"" ?>")
    a.writeline ("<eExact xmlns:xsi=""[URL]http://www.w3.org/2001/XMLSchema-instance[/URL]"" xsi:noNamespaceSchemaLocation=""eExact-Schema.xsd"">")
    a.writeline ("<Items>")
'   ----------------------------------------------------------------------------------------
'   Step 1: initialize
'   ----------------------------------------------------------------------------------------
     Sheets("A100").Range("A5").Value = Sheets("A100").Range("A5").Value + 1
    Action = True
    If Worksheets("A100").Cells(2, 1) = Empty Then
        MsgBox ("Dag niet gevuld")
        Action = False
        Exit Sub
        End If
    If Worksheets("A100").Cells(3, 1) = Empty Then
        MsgBox ("Maand niet gevuld")
       Action = False
       Exit Sub
       End If
     If Worksheets("A100").Cells(4, 1) = Empty Then
        MsgBox ("Jaar niet gevuld")
       Action = False
       Exit Sub
       End If

With Range("B2")
.Value = Now()
.NumberFormat = "dd/mm/yyyy h:mm:ss"
End With

'   ----------------------------------------------------------------------------------------
'   Step 2: Write records for Items
'   ----------------------------------------------------------------------------------------

    Itemrow = 7
    While Worksheets("A100").Cells(Itemrow, 1) <> Empty And Action
   
        Itemcode = Worksheets("A100").Cells(Itemrow, 1)
        SalesPrice = Replace(Worksheets("A100").Cells(Itemrow, 3), ",", ".")
        CostPrice = Replace(Worksheets("A100").Cells(Itemrow, 7), ",", ".")
'        SupplierMain = Worksheets("A100").Cells(Itemrow, 25)
'        SupplierCode = Worksheets("A100").Cells(Itemrow, 20)
'        SupplierPrice = Replace(Worksheets("A100").Cells(Itemrow, 16), ",", ".")
      
        Call WriteRecord(a)
        Itemrow = Itemrow + 1
    Wend
'   ----------------------------------------------------------------------------------------
'   Step 3: End file
'   ----------------------------------------------------------------------------------------
    If Action = True Then
        a.writeline ("</Items>")
    End If
    a.writeline ("</eExact>")
    a.Close
End Sub

Private Sub WriteRecord(ByVal a As Object)
    a.writeline (" <Item code=""" & Itemcode & """ type=""S"">")
 
    a.writeline ("  <Sales>")
    a.writeline ("   <Price type=""S"">")
'    a.writeline ("    <Value>" & SalesPrice & "</Value>")
    'a.writeline ("    <VAT code=""" & VATCode & """/>")
     a.writeline ("   </Price>")
    'a.writeline ("   <Unit unit=""" & SalesUnit & """/>")
    a.writeline ("  </Sales>")
    a.writeline ("  <Costs>")
    a.writeline ("   <Price>")
    'a.writeline ("    <Currency code=""" & ItemCurrency & """/>")
    a.writeline ("    <Value>" & CostPrice & "</Value>")
    a.writeline ("   </Price>")
    a.writeline ("  </Costs>")
 
'    If SupplierCode <> Empty Then
'    a.writeline ("  <ItemAccounts>")
'    a.writeline ("   <ItemAccount default=""" & SupplierMain & """>")
'    a.writeline ("    <Account code="""" type=""S""><Creditor code=""" & SupplierCode & """/></Account>")
'    a.writeline ("    <Purchase>")
'    a.writeline ("     <Price type=""P"">")
'     a.writeline ("      <Value>" & SupplierPrice & "</Value>")
'      a.writeline ("     </Price>")
'    a.writeline ("    </Purchase>")
'      a.writeline ("   </ItemAccount>")
'    a.writeline ("  </ItemAccounts>")
'    End If
'
    a.writeline (" </Item>")
End Sub
 
Last edited by a moderator:
Upvote 0
Try moving this part of the code
VBA Code: 
     Sheets("A100").Range("A5").Value = Sheets("A100").Range("A5").Value + 1
    Action = True
    If Worksheets("A100").Cells(2, 1) = Empty Then
        MsgBox ("Dag niet gevuld")
        Action = False
        Exit Sub
        End If
    If Worksheets("A100").Cells(3, 1) = Empty Then
        MsgBox ("Maand niet gevuld")
       Action = False
       Exit Sub
       End If
     If Worksheets("A100").Cells(4, 1) = Empty Then
        MsgBox ("Jaar niet gevuld")
       Action = False
       Exit Sub
       End If
to the very top of the procedure before this part
VBA Code: 
'   ----------------------------------------------------------------------------------------
'   Create output file as an object in the system with the file name as stated in the SaveDir variable
'   If this file exists, it will be overwritten without questions asked
    SaveDir = Worksheets("A100").Cells(2, 35)
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set a = fs.CreateTextFile("" & SaveDir & "", True)
 
Upvote 0
Solution
Fluff said:
Try moving this part of the code
VBA Code: 
     Sheets("A100").Range("A5").Value = Sheets("A100").Range("A5").Value + 1
    Action = True
    If Worksheets("A100").Cells(2, 1) = Empty Then
        MsgBox ("Dag niet gevuld")
        Action = False
        Exit Sub
        End If
    If Worksheets("A100").Cells(3, 1) = Empty Then
        MsgBox ("Maand niet gevuld")
       Action = False
       Exit Sub
       End If
     If Worksheets("A100").Cells(4, 1) = Empty Then
        MsgBox ("Jaar niet gevuld")
       Action = False
       Exit Sub
       End If
to the very top of the procedure before this part
VBA Code: 
'   ----------------------------------------------------------------------------------------
'   Create output file as an object in the system with the file name as stated in the SaveDir variable
'   If this file exists, it will be overwritten without questions asked
    SaveDir = Worksheets("A100").Cells(2, 35)
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set a = fs.CreateTextFile("" & SaveDir & "", True)
Click to expand...
That did it, thank you so much. I am really happy this works now. Again thank you for the help.

Have a nice evening,

Romano
 
Upvote 0
Glad we could help & thanks for the feedback.
 
Upvote 0
You must log in or register to reply here.

Similar threads

Romano_odK
  • Solved
Where to put the Errorhandler
Replies
3
Views
208
Micron
M
N
  • Question
VBA - Copying specific data to open workbook.
Replies
1
Views
340
eiloken
E
B
  • Question
VBA code to cut and paste multiple filtered rows based on multiple criteria
Replies
2
Views
634
Alex Blakenburg
A
C
  • Solved
VBA - Checking for Duplicates
Replies
2
Views
161
cwhaley1
C
W
  • Solved
Moving/transferring data between tables with matching column names, not by column order - vba
Replies
5
Views
334
Alex Blakenburg
A

Forum statistics

Threads
1,216,098
Messages
6,128,812
Members
449,468
Latest member
AGreen17

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