i can not figure this out below is the code.... I hit the error for the 2nd case to open the form frmBookingLCL.show the form name is correct. I can't figure this out. the line with the **** us the error line. HELP!!
Public Sub SendBookingEmail()
StartTime = Timer
With Session
'check first 2 letters of shipper's code, if not US raise error
If IsStartPositionCorrect(5, 14, 2, "US") <> True Or IsStartPositionCorrect(5, 2, 8, "Customer") <> True And GetDisplayText(4, 20, 1) <> "0" Then
If MsgBox("You don't appear to be in Logis ocean export US file. Please enter the file first and then run the macro.", vbOKOnly, "Export file verification....") Then
Exit Sub
End If
End If
sTypeOfMessage = "booking"
sShipmentType = Trim(.GetDisplayText(9, 61, 3))
sFileType = Trim(.GetDisplayText(4, 32, 1))
bFullVersion = False
'On Error GoTo ErrHand
'Get Outlook if it's running
Set oOutlookApp = GetObject(, "Outlook.Application")
'collect data fields for the e-mail body
GetAllLogisDataBooking
'Blow up the question form
Select Case sShipmentType
Case "FCL", "CMF", "CCS", "FPR"
frmBookingFCL.Show
Case "LCL", "GWY", "CLD"
frmBookingLCL.Show**********ERROR HERE
Case Else
frmBookingFCL.Show
'frmBookingOthers.Show
End Select
End With
Finish = Timer
TimeTook = Finish - StartTime
MyMacroStats = GetProcedureStats("Booking Confirmation", TimeTook)
Exit Sub
ErrHand:
If Err = 429 Then
MsgBox "Please note you must start Microsoft Outlook first."
End
End If
End Sub
Most likely, the error is in your user form. See the code comments.
I tried to replicate the issue below:
Sub test()
'/Sub to load the user form.
Dim x As String
x = "a"
Select Case x
Case "a", "b", "c"
UserForm1.Show '/ It Will error-out here during debugging.
End Select
End Sub
Code in UserForm1
Private Sub UserForm_Initialize()
'/ Code from : https://msdn.microsoft.com/en-us/library/office/gg251554.aspx
'/ Actually the error happens here.
Dim RetVal ' Implicitly a Variant.
' Default property is assigned to Type 8 Variant RetVal.
RetVal = CreateObject("Excel.Application")
RetVal.Visible = True ' Error occurs here.
End Sub
So going by your intialize code, either you are missing or have incorrect name for one of these controls.
frTrucker,CheckBox1,txtPickupDate. Once you correct them, the error will be gone.
Related
I have a database with the following
Mainfrm Form (Main Form - it has popup messages on load event)
kikThemOut Form (Loads hidden with Main Form and every 5 sec it checks for field value on table if it is 1 then call the Function fGetOut())
GetOutMod Module (has fGetOut() Function)
it works all fine, except when application closing it loads the popup alerts from Mainfrm again! which should not load.
Mainfrm Form Code
Private Sub Form_Load()
'to check for T&I notifications
Dim trs As Recordset
Set trs = CurrentDb.OpenRecordset("Y22_CurrMonth")
If trs.EOF = False Then
Dim tMsg, tStyle, tTitle, tHelp, tCtxt, tResponse, tMyString
tMsg = "There are Notifications Due, Do you want to view them?"
tStyle = vbYesNo + vbExclamation + vbDefaultButton2
tTitle = "Notifications Alert"
tHelp = "DEMO.HLP"
tCtxt = 1000
tResponse = MsgBox(tMsg, tStyle, tTitle, tHelp, tCtxt)
If tResponse = vbYes Then ' User chose Yes.
DoCmd.OpenReport "Notifications Current Month", acViewReport, acWindowNormal
Else
tMyString = "No"
End If
End If
'to load the checker form
DoCmd.OpenForm "kikThemOut", , , , , acHidden
End Sub
and this is the GetOutMod Module to force users to exit the db
GetOutMod Module
Option Compare Database
Option Explicit
Function fGetOut() As Integer
Dim RetVal As Integer
Dim db As DAO.Database
Dim rst As Recordset
On Error GoTo Err_fGGO
Set db = DBEngine.Workspaces(0).Databases(0)
Set rst = db.OpenRecordset("KickEmOff", dbOpenSnapshot)
If rst.EOF And rst.BOF Then
RetVal = True
GoTo Exit_fGGO
Else
If DSum("GetOut", "KickEmOff") = "1" Then
Application.Quit
Else
RetVal = True
End If
End If
Exit_fGGO:
fGetOut = RetVal
Exit Function
Err_fGGO:
'Note lack of message box on error
Resume Next
End Function
And this code in the load event of kikThemOut form to check for the same condition, if it is 1 then load this popup message (I could not add popup message to my GetOutMod Module with the function fGetOut)
kikThemOut form Code
Private Sub Form_Timer()
If DSum("GetOut", "KickEmOff") = "1" Then
Set TaskDialogAC = New cTaskDialog
With TaskDialogAC
.Init
.MainInstruction = "Dashboard Maintenance"
.Flags = TDF_CALLBACK_TIMER
.Content = "The Dashboard will be closed after 20 seconds for maintenance"
.CommonButtons = TDCBF_CLOSE_BUTTON
.IconMain = IDI_WINLOGO
.Footer = "Closing in 20 seconds..."
.Title = "Dashboard Maintenance"
.AutocloseTime = 20 'seconds
.ParenthWnd = Me.hwnd
.ShowDialog
End With
Call fGetOut
Else
If DSum("GetOut", "KickEmOff") = "0" Then
DoCmd.Requery
End If
End If
End Sub
Really hard to read your code and figure out where your function is being called from.
But I'm assuming this should work for you as described
Add this before your fGetOut function
Public blClosing as Boolean
And then add this inside your function at the top (after On Error GoTo Err_fGGO)
if blClosing then
blClosing = False
Exit function
Else
blClosing = True
End if
I created a couple of user forms which operate a data in separate report workbook. My script can successfully proceed a value in digit type. Unfortunately the circumstances have changed and now it has to work with a Serial Numbers as: 29160012040000TZ. With that new value script after starting the Sub, open a report, but it never enter into a 'with' statement. It doesn't look for a value or doing something else. Just open a report workbook and freeze.
Below you can see the code lines where issue is present and a little description:
Single_PHA is a text window in User Form where user can enter a a value, proceeding value is 29160012040000TZ
Private Sub Wydaj_button_Click()
Workbooks.Open Filename:="N:\ENGINEERING\1. ENGINEERS\Mateusz Skorupka\PHA_Cleaning_report_path\PHA_CLEANING_REPORT.xlsm", ReadOnly:=False
Dim REPORT As Workbook
Set REPORT = Application.Workbooks("PHA_CLEANING_REPORT.xlsm")
Set TABLE = REPORT.Worksheets("Main_table")
...
With TABLE.Range("A1")
If Single_PHA = True Then
If Not IsError(Application.Match(Single_PHA.Value, .Range("A:A"), 0)) Then
Single_PHA_row = TABLE.Range("A:A").Find(What:=Single_PHA.Value, LookIn:=xlValues).Row
.Offset(Single_PHA_row - 1, 4).Value = Date
REPORT.Close SaveChanges:=True
Single_PHA.Value = ""
Exit Sub
Else
MsgBox "Numer seryjny głowicy nie istnieje w bazie"
REPORT.Close SaveChanges:=False
Exit Sub
End If
End If
End With
In VBA I don't know how to open something like debugger or make the print instruction which would show me how the variables look on specific steps.
I am not sure if VBA read the value as 29160012040000TZ as string. I tried to declare at the beginning a variable as Single_PHA_STR as String and the proceed it as just text, but no wins there:
Dim Single_PHA_STR As String
...
With TABLE.Range("A1")
If Single_PHA = True Then
Single_PHA_STR = Str(Single_PHA.Value)
If Not IsError(Application.Match(Single_PHA_STR, .Range("A:A"), 0)) Then
Single_PHA_row = TABLE.Range("A:A").Find(What:=Single_PHA_STR, LookIn:=xlValues).Row
.Offset(Single_PHA_row - 1, 4).Value = Date
REPORT.Close SaveChanges:=True
Single_PHA.Value = ""
Exit Sub
Else
MsgBox "Numer seryjny głowicy nie istnieje w bazie"
REPORT.Close SaveChanges:=False
Exit Sub
End If
End If
End With
I noticed that if in VBA IDE I write a bold value 29160012040000TZ, I get an error
Expected line number or label or statement or end of statement
and the value is highlighted in red.
Could someone help me in that field and explain the nature of issues:
To reproduce a situation you can create a simply user form with one TextBox and one CommandButton. In the same worksheet as user form in a column A put a values: 29160012040000 and 29160012042027IR
Then make a sub which execute after double click on command button with code:
Private Sub CommandButton1_Click()
With Worksheets("Sheet1").Range("A1")
If Text_box1 = True Then
If Not IsError(Application.Match(Text_box1.Value, .Range("A:A"), 0)) Then
Text_box1_row = Worksheets("Sheet1").Range("A:A").Find(What:=Text_box1.Value, LookIn:=xlValues).Row
.Offset(Text_box1_row - 1, 4).Value = Date
Text_box1.Value = ""
Exit Sub
Else
MsgBox "PHA SN not exist in a database"
Exit Sub
End If
End If
End With
End Sub
Then try to input in a UserForm's TextBox a value = 29160012040000 and you will see that script successfully filled a forth column in row with current date. Then try to input a value 29160012042027IR and you will see that nothing happened. Script don't proceed that value at all.
So that is my issue and question indeed. How to process a value with letters at the end like: 29160012042027IR : )
I also tried to focus a script statement on one specific cell in which is a text value "29160012042027IR" that which I input into a UserForm TextBox. Looking with a debugger both of variables in if statement have the same text value, but still script miss that statement and go to else instructions : (
I mean abut: If Range("A3").Text = Text_box1.Text Then
When I change a statement for "If Range("A3").Value = Text_box1.Value Then" the same thing happen.
Private Sub CommandButton1_Click()
With Worksheets("Sheet1").Range("A:A")
If Text_box1 = True Then
If Range("A3").Text = Text_box1.Text Then
Text_box1_row = Worksheets("Arkusz1").Range("A:A").Find(What:=Text_box1.Value, LookIn:=xlWhole).Row
.Offset(Text_box1_row - 1, 4).Value = Date
Text_box1.Value = ""
Exit Sub
Else
MsgBox "PHA SN not exist in a database"
Exit Sub
End If
Else
MsgBox "Other loop"
End If
End With
End Sub
IMPORTANT NOTICE:
I found the main issue. I made wrong if condition, it should be:
If Single_PHA <> "" Then previously I have got: If Single_PHA = True Then, and there the results is a value not the boolean type.
Everything works. Thank everyone very much for help.
Topic is ready to be closed.
PS: thank you Tom for suggestion and tip with debugger: )
I have some VBA code that checks a person's job title before allowing someone to edit the document. After adding this code in I occasionally get an "Automation Error Catastrophic Failure" message only when opening the spreadsheet. As far as I can tell it does not damage any part of the workbook, and you just have to exit the command debugger twice before it opens. Obviously others at work see this message and overreact to it. Please see my functions that activate when opening the workbook.
Private Sub Workbook_Open()
Sheets("Start Here").Select
Range("A3").Select
End Sub
Private Sub Worksheet_Activate()
If Usercheck() = True Then
ProtectionOff
Else
ProtectionOff
Range("A1:V260").Locked = True
ProtectionOn
End If
End Sub
Function Usercheck() As Boolean
Dim user As String
Dim title As String
On Error GoTo ErrorHandler
user = UserName()
title = WorksheetFunction.VLookup(user,
Sheets("BaseTables").Range("tblStaff[[#All],[Username]:[Title1]]"), 2, False)
If Left(title, 20) = "Technical Specialist" Then
Usercheck = True
ElseIf Left(title, 19) = "Engineering Manager" Then
Usercheck = True
ElseIf Left(title, 9) = "Team Lead" Then
Usercheck = True
Else
Usercheck = False
End If
Exit Function
ErrorHandler:
Usercheck = False
End Function
Public Function UserName()
UserName = Environ$("UserName")
End Function
Does anyone know how to make a userform function in the same way as the Message Box 'ok' button? I'll explain.
I'm detecting errors in a column in a spreadsheet. When an error is found, a message box pops up as follows:
MsgBox "Please enter valid data"
When I select "OK" it goes to the next error in the column. This is great, except of course a message box is modal, which freezes the application. I want the user to be able to edit the data and then move to the next error. So, I designed a userform, which can be non-modal. Great, except I want the macro to advance to the next error. It will do that IF the user corrects the error. If they do not, it just stays at that error cell.
I know WHY this happens. My userform 'Next' button just calls the macro which finds the first error. But what I want to know is if there is a way around this.
Error checking starts at row 19 because that is where user input data starts.
I'm including a link to the spreadsheet here. Module 1 'NextValidationError' works great and proceeds to the next error. Module 14 just hangs at the error until it is resolved. I'd like it to be able to skip.
https://www.dropbox.com/s/yqko5kj19pnauc9/Transparency%20Data%20Input%20Sheet%20for%20Indirect%20Spend%20V7%2009212016%20v2%200.xlsm?dl=0
Can anyone give me advice on how to make module 14 proceed as module 1?
Something like this:
Dim r_start As Long
Sub CheckNames()
Dim r As Long
'Dim emptyRow As Boolean
If r_start = 0 Then r_start = 19
With ActiveSheet
For r = r_start To 5000
'Checks entire row for data. User may skip rows when entering data.
If WorksheetFunction.CountA(.Range(.Cells(r, 1), .Cells(r, 33))) > 0 Then
If ((.Cells(r, 2) = "") <> (.Cells(r, 3) = "")) Or _
((.Cells(r, 2) = "") = (.Cells(r, 4) = "")) Then
MsgBox "Please fill in First and Last Name or HCO in Row " & r & "."
End If
End If
Next
End With
End Sub
Unless I'm mis-reading your code you can combine your two checks with Or.
You will need some method to reset r_start when the user is done checking (if the form stays open after that).
EDIT: here's a very basic example.
UserForm1 has two buttons - "Next" and "Close"
Code for "next" is just:
Private Sub CommandButton1_Click()
ShowErrors
End Sub
In a regular module:
Dim r_start As Long
'this kicks off the checking process
Sub StartChecking()
r_start = 0
UserForm1.Show vbModeless
ShowErrors
End Sub
'a simple example validation...
Sub ShowErrors()
Dim c As Range, r As Long
If r_start = 0 Then r_start = 9
For r = r_start To 200
With ActiveSheet.Rows(r)
If Not IsNumeric(.Cells(1).Value) Then
UserForm1.lblMsg.Caption = "Cell " & .Cells(1).Address() & " is not numeric!"
r_start = r + 1
Exit Sub
End If
End With
Next r
r_start = 0
UserForm1.lblMsg.Caption = "No more errors"
End Sub
I have code which looks like this:
Select Case IsNumeric(somevariable)
Case True
Resume Next
Case False
Call notnum
Else
Call MyErrorHandler
End Select
Is this overthinking it? Is there a chance IsNumeric will return something other than True or False here or is this bad programming practice?
Don't need the else as it will be true or false however, just a note the Else should be Case Else (moot point though as you are about to delete it)
Based on this though I wouldn't use a case for only 2 options:
If IsNumeric(somevariable) then
Resume Next
Else
Call MyErrorHandler
End if
Edit: Here is how error checking works:
Sub SheetError()
Dim MySheet As String
On Error GoTo ErrorCheck
MySheet = ActiveSheet.name
Sheets.Add
ActiveSheet.name = MySheet
MsgBox "I continued the code"
ActiveSheet.name = "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"
MsgBox "I will never get to here in the code"
End
ErrorCheck:
If Err.Description = "Cannot rename a sheet to the same name as another sheet, a referenced object library or a workbook referenced by Visual Basic." Then
Resume Next
Else
MsgBox "Error I am not designed to deal with"
End If
End Sub
Copy and paste this module to your personal workbook or to a new workbook and run it, step through line by line using F8 to see how it is actually dealing with the error.
From OP's comment I'm not using my error handler. I want to do stuff with the hopefully numeric output
Sub demo()
Dim inputs As Variant
inputs = InputBox("Prompt", "Title", "Default")
If Not IsNumeric(inputs) Then
notnum
Else
' Do what you want with numeric input inside the Else
End If
' Maybe do more stuff irrespective of input
End Sub
Sub notnum()
' do not numeric stuff here
End Sub
Or if you want to keep prompting for numeric input until the users gets it right or cancels
Sub demo2()
Dim inputs As Variant
Do
inputs = InputBox("Enter something Numeric", "Title", "Default")
Loop Until IsNumeric(inputs) Or inputs = vbNullString
If Not inputs = vbNullString Then
' Do wht you want with numeric input inside the Else
End If
' Maybe do more stuff irrespective of input
End Sub
Input box can have different type of input validation. Try this
something = Application.InputBox("Pls Insert the Number", Type:=1)
If something = False Then Exit Sub
'Type:=0 A formula
'Type:=1 A number
'Type:=2 Text (a string)
'Type:=4 A logical value (True or False)
'Type:=8 A cell reference, as a Range object
'Type:=16 An error value, such as #N/A
'Type:=64 An array of values