Is it possible to edit the input in a UserForm in VBA? - vba

I am creating a yard management system to keep track of open parking spots in a lot. The userform allows the user to click on a spot in the map that is open and fill out a list of information about the truck going to that spot. Right now, if I make an error in the entry I have to redo the whole form, rather than just being able to edit the information I have already entered. Is there a way to do that without having to retype everything?
Here is the code for the user form:
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdClear_Click()
ActiveCell.ClearContents
ActiveCell.Interior.Color = vbGreen
Unload Me
End Sub
Private Sub cmdUpdate_Click()
UpdateInfo.Show
Unload Me
End Sub
Private Sub CommandButton1_Click()
UpdateInfo.Show
Unload Me
End Sub
Private Sub UserForm_Initialize()
lblInfo = ActiveCell.Value
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set rngBDock = Range("BX7:CO7")
Set rngBulk = Range("BZ21:CG21")
Set rngTransT = Range("BF17:BY17")
Set rngTransT1 = Range("BG21:BY21")
Set rngTDock = Range("BL7:BW7")
Set rngEDock = Range("CP7:CT7")
Set rngNDock = Range("CU7:DC7")
Set rngFence = Range("CQ13:CV13")
Set rngNSide = Range("CW13:DB13")
Set rngGEO = Range("BG28:DD28")
Set rngNight = Range("CH21:DD21")
Set rngNewT = Range("DK31:DK65")
Set rngNewTl = Range("DI31:DI65")
Set rngOff = Range("BN40:CL40")
Set rngOffl = Range("BN42:CL42")
Set rng = Union(rngBDock, rngBulk, rngTransT, rngTransT1, rngTDock, rngEDock, rngNDock, rngFence, rngNSide, rngGEO, rngNight, rngNewT, rngNewTl, rngOff, rngOffl)
If Not Intersect(Target, rng) Is Nothing Then
CellInfo.Show
'ActiveCell.Value = cellFill
If Not IsEmpty(ActiveCell.Value) Then
Call RealTimeTracker
End If
End If
Private Sub cmdOkUpdate_Click()
Dim i As Integer, j As Integer
For i = 0 To lbxOption.ListCount - 1
If lbxOption.Selected(i) Then j = j + 1
Next i
If j = 0 Then
MsgBox "Please select an option. ", , "Warning"
Unload Me
UpdateInfo.Show
ElseIf j = 1 Then
NoFill = False
End If
strBOL = txtBOL.Value
strID = txtID.Value
details = txtDet.Value
opt = lbxOption.Value
currtime = time()
today = Format(Now(), "MM/DD/YYYY")
emp = TextBox1.Value
With ActiveCell
spot = .Offset(-1, 0)
If Len(spot) = 0 Then
spot = .Offset(1, 0)
Else
spot = spot
End If
End With
If NoFill = True Then
cellFill = ""
ElseIf NoFill = False Then
With Sheet5
.Range("A1").Value = "Time"
.Range("B1").Value = "Date"
.Range("C1").Value = "Location"
.Range("D1").Value = "Category"
.Range("E1").Value = "BOL"
.Range("f1").Value = "Trailer #"
.Range("g1").Value = "Details"
.Range("H1").Value = "EE Name"
.Range("A2").EntireRow.Insert
.Range("A2").Value = currtime
.Range("B2").Value = today
.Range("C2").Value = spot
.Range("D2").Value = opt
.Range("E2").Value = strBOL
.Range("F2").Value = strID
.Range("G2").Value = details
.Range("H2").Value = emp
.Columns("A:H").AutoFit
End With
If Not IsEmpty(opt) Then
cellFill = opt & " " & vbCrLf & "BOL (last 5 digits): " & strBOL & " " & vbCrLf & "Trailer # " & strID & " " & vbCrLf & details & "EE Name" & emp & " " & vbCrLf
ActiveCell.Value = cellFill
Call RealTimeTracker
End If
End If
Unload Me
Sheet1.Activate
End Sub

Related

"execution interrupted" and VB editor highlights "end if" in yellow

I have several transactions to automate and then paste into several tables.
My code works for my first transaction but for the others I put the same code I just deleted the sheets in which I put it and it doesn't work at all.
Public SapGuiAuto, WScript, msgcol
Public objGui As GuiApplication
Public objConn As GuiConnection
Public objSess As GuiSession
Public objSBar As GuiStatusbar
Public objSheet As Worksheet
Dim W_System
Const fpath = "C:\Users\p100789\Documents\SAP\SAP GUI"
Const ffilename = "text.txt"
Sub OpenCSVFile()
'
' Load the CSV extract
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & fpath & "\" & ffilename, Destination:=Range("$A$1"))
.Name = "text"
.FieldNames = True
.RowNumbers = False
[...]
End With
With ActiveSheet
.Columns(1).EntireColumn.Delete
'delete first column
.Columns(1).EntireColumn.Insert
.Rows("1:11").EntireRow.Delete 'delete first 9 rows
End With
End Sub
Function Attach_Session() As Boolean
Dim il, it
Dim W_conn, W_Sess
If W_System = "" Then
Attach_Session = False
Exit Function
End If
If Not objSess Is Nothing Then
If objSess.Info.SystemName & objSess.Info.Client = W_System Then
Attach_Session = True
Exit Function
End If
End If
If objGui Is Nothing Then
Set SapGuiAuto = GetObject("SAPGUI")
Set objGui = SapGuiAuto.GetScriptingEngine
End If
For il = 0 To objGui.Children.Count - 1
Set W_conn = objGui.Children(il + 0)
For it = 0 To W_conn.Children.Count - 1
Set W_Sess = W_conn.Children(it + 0)
If W_Sess.Info.SystemName & W_Sess.Info.Client = W_System Then
Set objConn = objGui.Children(il + 0)
Set objSess = objConn.Children(it + 0)
Exit For
End If
Next
Next
If objSess Is Nothing Then
MsgBox "No active session to system " + W_System + ", or scripting is not
enabled.", vbCritical + vbOKOnly
Attach_Session = False
Exit Function
End If
If IsObject(WScript) Then
WScript.ConnectObject objSess, "on"
WScript.ConnectObject objGui, "on"
End If
Set objSBar = objSess.findById("wnd[0]/sbar")
objSess.findById("wnd[0]").maximize
Attach_Session = True
End Function
Public Sub RunGUIScript()
Dim W_Ret As Boolean
Dim Société As String
Sheets("Extraction").Select
Société = Range("b9")
' Connect to SAP
W_Ret = Attach_Session
If Not W_Ret Then
Exit Sub
End If
On Error GoTo myerr
[....script]
Exit Sub
myerr:
MsgBox "Error occured while retrieving data", vbCritical + vbOKOnly
End Sub
Sub StartExtract()
' Set the sid and client to connect to
W_System = "P10320"
' Run the GUI script
RunGUIScript
' End the GUI session
objSess.EndTransaction
'effacer contenu feuille temp
Sheets("temp").Select
Cells.Select
Selection.Delete Shift:=xlUp
' Switch to the worksheet where the data is loaded to
Sheets("temp").Select
' Load the CSV file
OpenCSVFile
[...]
' Update the time and date on the control worksheet
Sheets("Extraction").Select
Cells(2, 2).Value = Now()
in short, to automate another transaction I put the same code after, by filling the script with the new script. It doesn't work, does anyone have a solution?

Userform VBA Select Printer before printing

I have created a userform and have become stuck on the final stage and was wondering if somebody could assist or point me in the right direction.
I have the user selecting checkboxes for the sheets they require to print, however, due to the printers being on a network I need them to select a printer so ideally would need a popup box or print preview.
Private Sub CommandButton1_Click()
'OK = MsgBox("Printing", vbExclamation + vbOKOnly, "Sucsess")
If Me.CheckBox1 = 0 And Me.CheckBox2 = 0 And Me.CheckBox3 = 0 And Me.CheckBox4 = 0 And Me.CheckBox5 = 0 And Me.CheckBox6 = 0 And Me.CheckBox7 = 0 And Me.CheckBox8 = 0 And Me.CheckBox9 = 0 And Me.CheckBox10 = 0 Then
MsgBox "You need to select at least 1 form", vbCritical + vbOKOnly, "Error"
Else
If Me.CheckBox2 = 1 And Me.ComboBox3 = Null Then
MsgBox "Please select the number of witness statements required!", vbCritical + vbOKOnly, "Witness Staements"
Else
OK = MsgBox("Printing", vbExclamation + vbOKOnly, "Sucsess")
'Print the First Page everytime
ActiveDocument.ActiveWindow.PrintOut Range:=wdPrintRangeOfPages, Item:= _
wdPrintDocumentContent, Pages:="1" & p
'Inserting Pre info Code into the form
Dim Pg1Name As Range
Set Pg1Name = ActiveDocument.Bookmarks("Pg1Name").Range
Pg1Name.Text = Me.TextBox3.Value
Dim S1Name As Range
Set S1Name = ActiveDocument.Bookmarks("S1Name").Range
S1Name.Text = Me.TextBox3.Value
Dim S5Name As Range
Set S5Name = ActiveDocument.Bookmarks("S5Name").Range
S5Name.Text = Me.TextBox3.Value
Dim S6Name As Range
Set S6Name = ActiveDocument.Bookmarks("S6Name").Range
S6Name.Text = Me.TextBox3.Value
Dim Pg1Date As Range
Set Pg1Date = ActiveDocument.Bookmarks("Pg1Date").Range
Pg1Date.Text = Me.TextBox1.Value
Dim S1Date As Range
Set S1Date = ActiveDocument.Bookmarks("S1Date").Range
S1Date.Text = Me.TextBox1.Value
Dim Pg1Time As Range
Set Pg1Time = ActiveDocument.Bookmarks("Pg1Time").Range
Pg1Time.Text = Me.TextBox2.Value
Dim S1Time As Range
Set S1Time = ActiveDocument.Bookmarks("S1Time").Range
S1Time.Text = Me.TextBox2.Value
Dim Pg1Dept As Range
Set Pg1Dept = ActiveDocument.Bookmarks("Pg1Dept").Range
Pg1Dept.Text = Me.ComboBox2.Value
Dim S5Dept As Range
Set S5Dept = ActiveDocument.Bookmarks("S5Dept").Range
S5Dept.Text = Me.ComboBox2.Value
Dim S6Dept As Range
Set S6Dept = ActiveDocument.Bookmarks("S6Dept").Range
S6Dept.Text = Me.ComboBox2.Value
Dim Pg1Site As Range
Set Pg1Site = ActiveDocument.Bookmarks("Pg1Site").Range
Pg1Site.Text = Me.ComboBox1.Value
'Print Section 1 Immediate Response
If Accident_Incident_Form_Creator.CheckBox1.Value = True Then
ActiveDocument.ActiveWindow.PrintOut Range:=wdPrintRangeOfPages, Item:=wdPrintDocumentContent, Pages:="2" & p
End If
'Print Section 2 Witness Statement
If Accident_Incident_Form_Creator.CheckBox2.Value = True Then
ActiveDocument.ActiveWindow.PrintOut Range:=wdPrintRangeOfPages, Item:=wdPrintDocumentContent, Copies:=Me.ComboBox3.Value, Pages:="3" & p
End If
'Print Section 3 Information Gathering
If Accident_Incident_Form_Creator.CheckBox3.Value = True Then
ActiveDocument.ActiveWindow.PrintOut Range:=wdPrintRangeOfPages, Item:=wdPrintDocumentContent, Pages:="4" & p
End If
'Print Section 4 First Aid
If Accident_Incident_Form_Creator.CheckBox4.Value = True Then
ActiveDocument.ActiveWindow.PrintOut Range:=wdPrintRangeOfPages, Item:=wdPrintDocumentContent, Pages:="5" & p
End If
'Print Section 5 Damage Report
If Accident_Incident_Form_Creator.CheckBox5.Value = True Then
ActiveDocument.ActiveWindow.PrintOut Range:=wdPrintRangeOfPages, Item:=wdPrintDocumentContent, Pages:="6" & p
End If
'Print Section 6 Environmental Report
If Accident_Incident_Form_Creator.CheckBox6.Value = True Then
ActiveDocument.ActiveWindow.PrintOut Range:=wdPrintRangeOfPages, Item:=wdPrintDocumentContent, Pages:="7" & p
End If
'Print Section 7 & 8 Manual Handling & MHE
If Accident_Incident_Form_Creator.CheckBox7.Value = True Then
ActiveDocument.ActiveWindow.PrintOut Range:=wdPrintRangeOfPages, Item:=wdPrintDocumentContent, Pages:="8" & p
End If
'Print Section 9 Root Cause Investigation
If Accident_Incident_Form_Creator.CheckBox8.Value = True Then
ActiveDocument.ActiveWindow.PrintOut Range:=wdPrintRangeOfPages, Item:=wdPrintDocumentContent, Pages:="9" & p
End If
'Print Section 10 Root Cause Corrective Actions
If Accident_Incident_Form_Creator.CheckBox9.Value = True Then
ActiveDocument.ActiveWindow.PrintOut Range:=wdPrintRangeOfPages, Item:=wdPrintDocumentContent, Pages:="9" & p
End If
'Print Section 11 Safety Signoff
If Accident_Incident_Form_Creator.CheckBox10.Value = True Then
ActiveDocument.ActiveWindow.PrintOut Range:=wdPrintRangeOfPages, Item:=wdPrintDocumentContent, Pages:="11" & p
End If
If OK = 1 Then
'Close and don't save
Application.DisplayAlerts = False
ActiveDocument.Close
ActiveWindow.Close
Application.DisplayAlerts = True
End If
End If
End If
End Sub

Userform automatic fillout ID number ans subtract the word infront

I have created a simple UserForm to enter new equipment details to the Tooling list in the spreadsheet, form works fine except for one little thing, which is New Tool ID.
Basically what I need this for to do is once form is opened/called new Tool ID need to be created, which could be and Alfa numerical set of characters like AA-01234, AA-01235, AA-01236 and so on.
Also, is there a way of posting newly added Tool ID in the MsgBox along with MsgBox "One record added to Customers List. New Customer ID is "
All of my attempts to create this are failing and causing errors, which I really cannot figure out since I am new to VBA and had never used it until now.
Here is my code, Customer ID is TextBox1.
Thanks in advance
[![enter image description here][1]][1]
Here is the code working for me but it won't subtract the word out.
Private Sub CommandButton1_Click()
If Application.WorksheetFunction.CountIf(Range("A:A"), Me.TextBox1) > 0 Then
If MsgBox("Tool Name Already Exists.Do you want to continue?", vbQuestion + vbYesNo) <> vbYes Then
Exit Sub
End If
End If
If TextBox1.Value = "" Or TextBox2.Value = "" Or TextBox4.Value = "" Or TextBox5.Value = "" Or TextBox6.Value = "" Then
If MsgBox("Form is not complete. Do you want to continue?", vbQuestion + vbYesNo) <> vbYes Then
Exit Sub
End If
End If
Dim ssheet As Worksheet
Set ssheet = ThisWorkbook.Sheets("2018")
nr = ssheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
ssheet.Cells(nr, 1) = TextBox1.Value
ssheet.Cells(nr, 2) = TextBox2.Value
ssheet.Cells(nr, 3) = TextBox3.Value
ssheet.Cells(nr, 4) = TextBox4.Value
ssheet.Cells(nr, 5) = TextBox5.Value
ssheet.Cells(nr, 6) = TextBox6.Value
ssheet.Cells(nr, 7) = TextBox7.Value
Call resetForm
End Sub
Sub resetForm()
TextBox1.Value = ""
TextBox2.Value = ""
TextBox4.Value = ""
TextBox5.Value = ""
TextBox6.Value = ""
TextBox7.Value = ""
Data_Entry.TextBox1.SetFocus
End Sub
Private Sub CommandButton2_Click()
TextBox1.Value = ""
TextBox2.Value = ""
TextBox4.Value = ""
TextBox5.Value = ""
TextBox6.Value = ""
TextBox7.Value = ""
Data_Entry.TextBox1.SetFocus
End Sub
Private Sub UserForm_Initialize()
Me.TextBox1 = Application.WorksheetFunction.Max(Range("A:A")) + 1
Me.TextBox3 = Date
End Sub
Private Sub UserForm_Initialize()
Me.TextBox1 = Application.WorksheetFunction.Max(Range("A:A")) + 1
Me.TextBox3 = Date
End Sub
[1]: https://i.stack.imgur.com/yQABC.jpg

VBA code for inserting unique text to each of 12 cells, when cells are blank

I am new to VBA and am severely stuck! I have 12 cells that I need to add specific text to, but only if the cells are blank. I managed to find code for 1 of them which is shown below:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$D$3" Then
If Target.Value = "Insert name of project (if known)" Then
Target.Font.ColorIndex = xlAutomatic
Target.Value = ""
Exit Sub
End If
End If
If [D3].Value = "" Then
[D3].Value = "Insert name of project (if known)"
[D3].Font.ColorIndex = 1
Else
[D3].Font.ColorIndex = xlAutomatic
End If
End Sub
However, seemingly I can only use this once per sheet. I need code that is similar to this that will hopefully do the same job. The remaining 11 cells need to have unique text.
Basically what I am trying to do is prompt the user to insert details in each of these cells and once the cells are filled, the form will be complete.
Any assistance is appreciated.
Hi, Apologies for the delay. This is the final edit, which works perfectly. I thought I was going to have an issue with 'undo' (CTRL+Z) but it seems to be fine now. Thanks again.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim clls(1 To 12) As String
Dim msg(1 To 12) As String
Dim i As Long, addr As String, c As Range
clls(1) = "D3": msg(1) = "Insert name of project (if known)"
clls(2) = "D4": msg(2) = "Insert closest street address"
clls(3) = "H3": msg(3) = "Insert name of landowner (if applicable)"
clls(4) = "H4": msg(4) = "Insert name of Developer (if applicable)"
clls(5) = "H6": msg(5) = "Insert name of PM Co. (if different from above)"
clls(6) = "H7": msg(6) = "Insert name of Designer (if applicable)"
clls(7) = "H8": msg(7) = "Insert name of Constructor"
clls(8) = "L3": msg(8) = "Insert project number (if known)"
clls(9) = "L6": msg(9) = "Insert name"
clls(10) = "L7": msg(10) = "Insert submission date"
clls(11) = "D10": msg(11) = "Brief description of project: Adjustment, deviation, main upsizing, main extension, lead-in, lead-out, etc."
clls(12) = "D11": msg(12) = "Insert length of asset (number only)"
Set c = Target.Cells(1)
addr = c.Address(False, False)
For i = 1 To UBound(clls)
If addr = clls(i) Then
If c.Value = msg(i) Then
c.Font.ColorIndex = xlAutomatic
c.Value = ""
End If
Else
With Me.Range(clls(i))
If .Value = "" Then
.Value = msg(i)
.Font.ColorIndex = 1
End If
End With
End If
Next i
End Sub
Might need a bit of tweaking...
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim clls(1 To 5) As String
Dim msg(1 To 5) As String
Dim i As Long, addr As String, c As Range
clls(1) = "D3": msg(1) = "Message 1"
clls(2) = "D4": msg(2) = "Message 2"
clls(3) = "D5": msg(3) = "Message 3"
clls(4) = "D6": msg(4) = "Message 4"
clls(5) = "D7": msg(5) = "Message 5"
Set c = Target.cells(1)
addr = c.Address(False, False)
For i = 1 To UBound(clls)
If addr = clls(i) Then
If c.Value = msg(i) Then
c.Font.ColorIndex = xlAutomatic
c.Value = ""
End If
Else
With Me.Range(clls(i))
If .Value = "" Then
.Value = msg(i)
.Font.ColorIndex = 1
End If
End With
End If
Next i
End Sub

Subroutine unexpectedly ends when a Workbook is closed

my problem today is a part of a subroutine that inexplicably breaks its execution when a Workbook is closed.
I have written the following code:
Public Const Pi As Double = 3.14159265358979
Public Const Rad As Double = Pi / 180
Public CalcBook As Workbook
Public FilePath As String, Files() As String
Public FreqArray() As Integer
Sub Main()
Dim ChooseFolder As Object, FilePath As String, StrFile As String
Dim i As Integer, j As Integer, k As Integer, x As Integer
Dim DirNum As Integer, HNum As Integer, VNum As Integer
Dim DirColShift As Integer, HColShift As Integer, VColShift As Integer
Dim TheStart As Date, TheEnd As Date, TotalTime As Date
Set ChooseFolder = Application.FileDialog(msoFileDialogFolderPicker)
With ChooseFolder
.AllowMultiSelect = False
.Title = "Please choose a folder containing .txt files"
If .Show = -1 Then
FilePath = .SelectedItems(1) & "\"
Else
Set ChooseFolder = Nothing
Exit Sub
End If
End With
Set ChooseFolder = Nothing
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayStatusBar = False
' Stores only files containing an AntennaName + "_T" + any number of characters + "_?_?45.xls" string
' (where "?" is a single character and "*" is any number). Checks if the number of files is correct too.
StrFile = Dir(FilePath & "*_T*_?_?45.txt")
Do While Len(StrFile) > 0
ReDim Preserve Files(i)
Files(i) = FilePath & StrFile
i = i + 1
StrFile = Dir
Loop
If Not (UBound(Files) + 1) / 6 = Int((UBound(Files) + 1) / 6) Then GoTo FileError
For i = 0 To UBound(Files)
Select Case Right(Files(i), 9)
Case "D_+45.txt", "D_-45.txt"
DirNum = DirNum + 1
Case "H_+45.txt", "H_-45.txt"
HNum = HNum + 1
Case "V_+45.txt", "V_-45.txt"
VNum = VNum + 1
End Select
Next
If Not (DirNum / 2 = Int(DirNum / 2) And HNum / 2 = Int(HNum / 2) And VNum / 2 = Int(VNum / 2) And DirNum = HNum And HNum = VNum) Then
FileError:
MsgBox "Failed to properly load files. Looks like a wrong number of them is at dispose", vbCritical, "Check the import-files"
Exit Sub
End If
' Imports files in Excel for better data access
Set CalcBook = Application.Workbooks.Add
' FROM HERE ON THE DATA IS PROCESSED IN ORDER TO OBTAIN AN EXCEL WORKBOOK WITH 3 SHEETS CALLED "Directivity", "Horizontal" and "Vertical".
Application.ScreenUpdating = True
Options.Show
TheStart = Now
Application.ScreenUpdating = False
If Options.OnlyEval = False Then PolarCharts
If Options.OnlyCharts = False Then Auswertung
Application.DisplayAlerts = False
CalcBook.Close savechanges:=False
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Set CalcBook = Nothing
TheEnd = Now
TotalTime = TheEnd - TheStart
MsgBox Format(TotalTime, "HH:MM:SS"), vbInformation, "Computing Time"
Unload Options
End Sub
Options is a form which I need in order to access data for the PolarCharts and Auswertung. These Subs are correctly executed (I know that because the data they save is correct too).
I tried deleting the .ScreenUpdating and .DisplayAlerts commands, as well as the Unload thinking that they could bugging something, but the result hasn't changed.
Know also that the Workbook I'm closing contains NO CODE at all (and nothing else addresses a ".Close" so it's impossible that something is executed on the .Close event).
Below my "Options" code:
Private Sub Cancel_Click()
End
End Sub
Private Sub UserForm_Terminate()
End
End Sub
Private Sub Ok_Click()
If Me.OnlyCharts = False Then
ReDim SubFreq(4)
If Not (Me.Start1.ListIndex = -1 And Me.Stop1.ListIndex = -1) Then SubFreq(0) = Me.Start1.List(Me.Start1.ListIndex) & "-" & Me.Stop1.List(Me.Stop1.ListIndex)
If Not (Me.Start2.ListIndex = -1 And Me.Stop2.ListIndex = -1) Then SubFreq(1) = Me.Start2.List(Me.Start2.ListIndex) & "-" & Me.Stop2.List(Me.Stop2.ListIndex)
If Not (Me.Start3.ListIndex = -1 And Me.Stop3.ListIndex = -1) Then SubFreq(2) = Me.Start3.List(Me.Start3.ListIndex) & "-" & Me.Stop3.List(Me.Stop3.ListIndex)
If Not (Me.Start4.ListIndex = -1 And Me.Stop4.ListIndex = -1) Then SubFreq(3) = Me.Start4.List(Me.Start4.ListIndex) & "-" & Me.Stop4.List(Me.Stop4.ListIndex)
If Not (Me.Start5.ListIndex = -1 And Me.Stop5.ListIndex = -1) Then SubFreq(4) = Me.Start5.List(Me.Start5.ListIndex) & "-" & Me.Stop5.List(Me.Stop5.ListIndex)
If (Me.Start1 = "" And Me.Start2 = "" And Me.Start3 = "" And Me.Start4 = "" And Me.Start5 = "" And Me.Stop1 = "" And Me.Stop2 = "" And Me.Stop3 = "" And Me.Stop4 = "" And Me.Stop5 = "") _
Or Me.Start1.Value > Me.Stop1.Value Or Me.Start2.Value > Me.Stop2.Value Or Me.Start3.Value > Me.Stop3.Value Or Me.Start4.Value > Me.Stop4.Value Or Me.Start5.Value > Me.Stop5.Value _
Or (Me.Start1.ListIndex = -1 And Me.Stop1.ListIndex >= 0) Or (Me.Start2.ListIndex = -1 And Me.Stop2.ListIndex >= 0) Or (Me.Start3.ListIndex = -1 And Me.Stop3.ListIndex >= 0) Or (Me.Start4.ListIndex = -1 And Me.Stop4.ListIndex >= 0) Or (Me.Start5.ListIndex = -1 And Me.Stop5.ListIndex >= 0) _
Or (Me.Start1.ListIndex >= 0 And Me.Stop1.ListIndex = -1) Or (Me.Start2.ListIndex >= 0 And Me.Stop2.ListIndex = -1) Or (Me.Start3.ListIndex >= 0 And Me.Stop3.ListIndex = -1) Or (Me.Start4.ListIndex >= 0 And Me.Stop4.ListIndex = -1) Or (Me.Start5.ListIndex >= 0 And Me.Stop5.ListIndex = -1) Then
MsgBox("Please select correctly the frequency ranges - Maybe Start > Stop, one of those was not properly inserted, or the fields are blank", vbExclamation, "Frequency choice error")
GoTo hell
End If
For i = 0 To 4
If Not SubFreq(i) = "" Then j = j + 1
Next i
j = j - 1
ReDim Preserve SubFreq(j)
End If
Me.Hide
hell:
End Sub
Private Sub UserForm_Initialize()
Dim i As Byte
Me.StartMeas = Date
Me.StopMeas = Date
Me.Worker.AddItem "lol"
Me.Worker.AddItem "rofl"
Me.Worker.ListIndex = 0
For i = LBound(FreqArray) To UBound(FreqArray)
Me.Start1.AddItem FreqArray(i)
Me.Start2.AddItem FreqArray(i)
Me.Start3.AddItem FreqArray(i)
Me.Start4.AddItem FreqArray(i)
Me.Start5.AddItem FreqArray(i)
Me.Stop1.AddItem FreqArray(i)
Me.Stop2.AddItem FreqArray(i)
Me.Stop3.AddItem FreqArray(i)
Me.Stop4.AddItem FreqArray(i)
Me.Stop5.AddItem FreqArray(i)
Next i
Me.Start1.ListIndex = 0
Me.Stop1.ListIndex = Me.Stop1.ListCount - 1
End Sub
Apparently when I Close CalcBook, it triggers the UserForm_Terminate event from Options which Ends all the code! How do I avoid this?
Just remove the statement End bacause End causes the abrupt end of code execution.
I see End in the Cancel and Terminate event handlers. If you have it on other places, remove it es well.
If you need exit from a method then use Exit Sub.
Why: because End work that way. Read e.g. this post: http://www.vbforums.com/showthread.php?511766-Classic-VB-Why-is-using-the-End-statement-(or-VB-s-quot-stop-quot-button)-a-bad-idea.
If you need stop code from execution use If-condition or even Exit Sub but avoid using End for it.
Try
Workbooks("CalcBook").Close savechanges:=False
I suspect that both error alerts and indications of an error on the screen are being suppressed