I have a 'protection' sub procedure Sub unprot_manually() which can been seen below. I have another sub procedure which could be refereed to as the main procedure of the workbook. I would like to call this protection procedure prior to allowing the user to run the main procedure. With my current code below, the user is able to run the main procedure regardless of entering the correct password. Do I need to create a 'protection' function, define as Boolean, and then pass as a parameter to the main sub?
Sub unprot_manually()
Dim password_input
Dim Pass As String
Application.ScreenUpdating = False
Pass = "xxxxxx"
password_input = Application.InputBox("Password", "Awaiting User Input..")
If password_input = Pass Then
Call Unprot
'Else
'MsgBox ("Incorrect, Good Bye")
'MsgBox ("Incorrect")
End If
Application.ScreenUpdating = True
End Sub
change it from a Sub to a Function, and then check the return value.
e.g. in your main procedure,
if unprot_manually then
rest of program
else
msgbox "Incorrect Passowrd"
end if
your other section would then become:
Function unprot_manually() as Boolean
'set to fail condition until we get a success status
unprot_manually=False
...
If password_input = Pass Then
Call Unprot
'passed, so set success condition
unpot_manually=True
End If
...
End Function
Creating a UDF to do a simple string comparison is a bit OTT. You don't even need a separate procedure for this, just put the If block in your main procedure
Sub Unprot()
If Application.InputBox("Password", "Awaiting User Input..") = "xxxxxx" Then
' Rest of code here
Else
MsgBox "Incorrect Password!"
End If
End Sub
Even better than this, just set the worksheet protection with the UserInterfaceOnly option set to true, then the user can't make any changes on the front end, but your code can still run without obstruction.
UPDATE: (In response to comment)
Just use a variable and check the input:
Sub Unprot()
Dim tempStr As String
tempStr = InputBox("Password", "Awaiting User Input..") ' Assign value via input
If tempStr = vbNullString Then Exit Sub 'If no input, exit sub
If tempStr = "xxxxxx" Then
'Rest of Code
Else
MsgBox "Incorrect Password!"
End If
End Sub
Related
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: )
This is the VBA code I am learning to write (got some reference from the Internet)
Public whatyousay As String
Sub testing()
b14
b15
End Sub
Function WorksheetExists(WSName As String) As Boolean
On Error Resume Next
WorksheetExists = Worksheets(WSName).Name = WSName
On Error GoTo 0
End Function
Sub b14()
Dim sh As Worksheet
Do Until WorksheetExists(whatyousay)
whatyousay = InputBox("Enter sheet name")
If Not WorksheetExists(whatyousay) Then MsgBox whatyousay & " doesn't exist.", vbExclamation
Loop
If WorksheetExists(whatyousay) Then Sheets(whatyousay).Activate
End Sub
Sub b15()
ThisWorkbook.Worksheets(whatyousay).Range("A1").Value = xxxx
End Sub
I must have wrongly adjust the code, as I can't find anyone having the same problem on the Internet.
When the button is clicked, it is supposed to prompt user input for the sheet name, then perform some actions.
Now, the problem I am facing is that the button only prompt user input for one time. If it was clicked the second time, it will used the previous user input without prompting.
Can anyone of you please point me to the right direction?
You are not erasing what was left in whatyousay during the last loop.
Sub b15()
ThisWorkbook.Worksheets(whatyousay).Range("A1").Value = xxxx
whatyousay = vbnullstring '<~~ remove the string from last time
End Sub
Personally, I avoid public vars. You can do the same thing by passing the string var into the secondary sub as a parameter.
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
I have a procedure that does some error checking for me and is called from a different procedure. What I want to be able to do is that if incorrect data has been entered and the error checking procedure finds this then I want to stop the procedure that called the error checking procedure. i.e. if error checking procedure is
sub errorCheck
and main procedure is
sub main
and main calls error checking. when error is found I want sub errorCheck to stop main. I have tried to use exit sub but this exits only the errorCheck sub not main
and help would be great thanks
Make it a function that returns a Boolean. Check if the value is False in the calling procedure main and then do an Exit Sub in the main procedure.
A bit nastier way to do it: Just type End instead of Exit Sub. This does however stop the execution of the code completely.
Something like this:
Function errorcheck() As Boolean
' in this case it is always false of course
errorcheck = False
End Function
Sub main()
If Not errorcheck Then
Exit Sub
End If
End Sub
You can use global object Err to complete this task.
Look at the example below:
Sub main()
'(...)
On Error Resume Next
Call errorChecking
If VBA.Err.Number = 999 Then
Exit Sub
End If
On Error GoTo 0
'(...)
End Sub
Sub errorChecking()
If Error Then
Call VBA.Err.Raise(999, "errorChecking", "Error found")
Exit Sub
End If
End Sub
Before we invoke function errorChecking we instruct VBA that it shouldn't stop if any error occurs - it should just ignore it and go to the next line of code instead.
Inside errorChecking function there is a conditional statement that checks if error occurred.
In case the error occurred, this function raise a new error with the number defined by you (999 in my example, you can come up with your own number).
Back in the Main function we check if the current number of VBA.Err object is 999. If it is, it means the error was raised by the function errorChecking and we can leave the Main sub.
Here is a simple example based on Tom's answer:
Sub MAIN()
Dim rng As Range, CellIsNogood As Boolean
Set rng = Application.InputBox(Prompt:="Enter range", Type:=8)
Call ErrorCheck(rng, CellIsNogood)
If CellIsNogood Then
MsgBox "error in range"
End If
End Sub
Sub ErrorCheck(r As Range, b As Boolean)
Dim rr As Range
b = False
For Each rr In r
If IsError(rr.Value) Then
b = True
End If
Next rr
End Sub
After seeing what Tom and had said I did a bit of research and got this working. Below is the code that I used. Thanks for the other answers :)
Private Function errorCheckingBox(box1, message) As Boolean
If Len(box1.value) = 0 Then
MsgBox message, vbExclamation, "Invalid Selection" ' displays a messgae box
box1.SetFocus
errorCheckingBox = True
End If
End Function
I'm trying to create a finance database that requires users to sign in and log out. I have that part working correctly. On the homepage of the database, I'm trying to get their last 25 (or X number) of transactions to display using a query. For some reason, I cannot get the code to pass as it shows a "Data type mismatch." Here is the various code - I'll explain each as I go:
Global Variables (My Global Module)
Option Compare Database
'global variables
Global C As Long
Global C2 As Long
Global HoldString As String
Global Flag As Boolean
Global Reply As String
Global mbReply As VbMsgBoxResult
Global User As String
Global GUser As Long
Global db As Database
The following are the Subs() to Log In (First Sub() is for Exit button, second sub() is for sign in button):
Option Compare Database
Private Sub B_Exit_Click()
mbReply = MsgBox(title:="Exit", _
prompt:="Are you sure you wish to exit the system?", _
Buttons:=vbYesNo)
If mbReply = vbNo Then
Exit Sub
Else
DoCmd.Quit acQuitSaveNone
End If
End Sub
Private Sub B_SignIn_Click()
'variables
Set db = CurrentDb()
Dim Employees As DAO.Recordset
Set Employees = db.OpenRecordset("Employees", dbOpenDynaset)
Dim isEmployeed As Boolean
Dim PassMatch As Boolean
Dim isTerm As Boolean
'check to see if the user is in the system
isEmployeed = False
PassMatch = False
isTerm = False
Do While Not Employees.EOF
If Employees![UserName] = T_Username.Value Then
isEmployeed = True
'make sure the employee is not terminated
If Employees![Terminated] = "Yes" Then
isTerm = True
End If
If isTerm = True Then
MsgBox ("This user has been terminated.")
Exit Sub
End If
'make sure password is correct
If Employees![Password] = T_Password.Value Then
PassMatch = True
End If
If PassMatch = False Then
MsgBox ("Incorrect Password.")
Exit Sub
End If
'mark signed in
Employees.Edit
Employees![SignedIn] = 1
Employees.Update
User = Employees![FirstName] & " " & Employees![LastName]
GUser = Employees![ID] 'Sets GUswer to equal record ID.
End If
Employees.MoveNext
Loop
If isEmployeed = False Then
MsgBox ("This username is not in the system.")
Exit Sub
End If
'close this form and open the main menu
Employees.Close
DoCmd.OpenForm FormName:="HomePage"
DoCmd.Close acForm, Me.Name, acSaveNo
End Sub
The next is my SQL code for the query:
SELECT TOP 25 Spend.ID, Spend.Vendor, Spend.MaterialGroup, Spend.GLCode, Spend.CostCenter, Spend.Department, Spend.InvoiceNumber, Spend.InvoiceDate, Spend.Amount, Spend.Tax, Spend.Total, Spend.DateEntered, Spend.DocNumber, Spend.Description, Spend.[Paid?], Spend.EnteredBy, Spend.EnteredBy
FROM Spend
WHERE (((Spend.[EnteredBy])="GUser"));
Spend.[EnteredBy] has a relationship with the Employees table. So EnteredBy is actually a number field because of this relationship.
If I hardcode the "WHERE" statement to be something like (((Spend.[EnteredBy])=2)); then the query will work fine.
Ultimately, what I want to happen is for the query to show the last 25 data entries that the logged on user completed.
Hope this makes sense. If there are questions, please let me know. I feel like I'm missing something small but I cannot figure it out.
Thanks,
Clark
Your query should read:
SELECT TOP 25 Spend.ID, Spend.Vendor, Spend.MaterialGroup, Spend.GLCode, Spend.CostCenter,
Spend.Department, Spend.InvoiceNumber, Spend.InvoiceDate, Spend.Amount, Spend.Tax, Spend.Total,
Spend.DateEntered, Spend.DocNumber, Spend.Description, Spend.[Paid?], Spend.EnteredBy, Spend.EnteredBy
FROM Spend WHERE (((Spend.[EnteredBy])=" & GUser & "));
Note the Ampersands ( & ) I placed before and after your GUser variable. This tells Access to evalute that expression and return the VALUE of it.
I'd also caution you against use the name "User" as a variable name. It's a Reserved Word in Access:
http://office.microsoft.com/en-us/access-help/access-2007-reserved-words-and-symbols-HA010030643.aspx