i have a ms access formular where there are given several Information. For "Status" Combobox there are several options like "1","2","3","4". If "4" is selected in "cbx_Status" then I want to add in Textbox "txt_ID_Order" an automatically increased ID and give an Order Time in textbox "txt_OrderTime". That's why I wrote this and works well:
Private Sub Form_BeforeUpdate(Cancel As Integer)
If Me.cbx_Status.Value = "4" Then
Me.txt_OrderTime = Now()
Me.txt_ID_Order = DMax("[ID_Order]", "tblX") + 1
Else:
Me.txt_ID_Order=""
Me.txt_OrderTime = ""
End If
End Sub
However, if Status "4" is for some reason changed and again selected , I want to keep that old ID. But right know wenn i do that, it's still increasing ID.
How can I fix it?
Thanks
Check for a value:
Private Sub Form_BeforeUpdate(Cancel As Integer)
If Me!cbx_Status.Value = "4" Then
If IsNull(Me!txt_OrderTime.Value) Then
Me!txt_OrderTime.Value = Now()
Me!txt_ID_Order.Value = DMax("[ID_Order]", "tblX") + 1
End If
Else
Me!txt_ID_Order.Value = Null
Me!txt_OrderTime.Value = Null
End If
End Sub
Not sure about the logic though; if you select anything else than 4, the textboxes will be cleared.
I'm having a difficult time doing military time or short time in the form view. I caught an error where the user put in 15:83 which shouldn't be allowed because the minutes are over 59, as well hours being over 23. However, I'm not sure how to create a form validation for something like that and I can't seem to find any documentation for it online surrounding this type of formatting.
in the validation rule property of the text box control on the form enter this expression
=Right([Text6],2)<60 Or Left([Text6],2)<24
i have assumed name of control is Text6
I can't seem to find any documentation for it online surrounding this
type of formatting.
That's because it is difficult and requires quite a lot of code, too much to post here. But, for example, to correct invalid input:
Private Sub Form_Error(DataErr As Integer, Response As Integer)
Const TimeHourMaximum As Integer = 24
Const TimeHourDefault As Integer = 20
Const TimeMinuteTenMax As Integer = 5
Dim ctl As Control
Dim Text As String
Dim SelStart As Integer
On Error Resume Next
Set ctl = Screen.ActiveControl
Select Case ctl.Name
Case "Logon"
Text = ctl.Text
SelStart = ctl.SelStart
If Not IsDate(Text) Then
DoCmd.Beep
If Val(Left(Text, 2)) > TimeHourMaximum Then
Mid(Text, 1) = CStr(TimeHourDefault)
ElseIf Len(Text) > 3 Then
' Length of Text is larger than two hour digits and the kolon.
Mid(Text, 1 + 3) = CStr(TimeMinuteTenMax)
End If
End If
ctl.Text = Text
ctl.SelStart = SelStart
ctl.SelLength = 1
Response = acDataErrContinue
End Select
Set ctl = Nothing
End Sub
Full code, documentation, and a demo application is posted with my project VBA.TimeEntry at GitHub:
Entering 24-hour time with input mask and full validation in Microsoft Access
I have two list boxes on a form I am making. The first list box is linked to a table with various company names. The goal I am after is after double clicking a companies name, the value is inserted in the second list box.
It worked fine until I tried to add code to prevent duplicates from appearing in the second list box, so you couldn't accidentally insert the same company twice. I have tried several different iterations, but with no luck. Anyone able to help with this one? My end goal would be for a msgbox to pop up alerting the user that duplicates are not allowed.
Private Sub ContractorLstbx_DblClick(Cancel As Integer)
Dim found As Boolean
found = False
Dim ID As Long
Dim Contractor As String
For Each newItem In Me.ContractorLstbx.ItemsSelected
For j = 0 To Me.SelectedContractorLst.ListCount - 1
If (Me!ContractorLstbx.ItemData(newItem).Column(1) = Me.SelectedContractorLst.ItemData(j).Column(1)) Then
found = True
Exit For
End If
Next j
If found = False Then
ID = Me.ContractorLstbx.ItemData(newItem)
Me.SelectedContractorLst.AddItem ContractorLstbx!.ItemData(newItem).Column(0) & ";" & Me!ContractorLstbx.ItemData(newItem).Column(1)
End If
found = False
Next newItem
End Sub
This is the full code for your solution. I tried it on test sample and working fine. just copy and paste the code. If you need your comparison to be case sensitive (I mean A <> a) then use Option Compare Binary as in my code below. If it is required to be case insensitive (A = a) just leave the default Option Compare Database or better force it using Option Compare Text
Option Compare Binary
Private Sub ContractorLstbx_DblClick(Cancel As Integer)
Dim found As Boolean
found = False
Dim ID As Long
Dim Contractor As String
For i = 0 To Me.ContractorLstbx.ItemsSelected.Count - 1
For j = 0 To Me.SelectedContractorLst.ListCount - 1
If (Me.ContractorLstbx.Column(1, Me.ContractorLstbx.ItemsSelected(i)) = Me.SelectedContractorLst.Column(1, j)) Then
found = True
Exit For
End If
Next j
If found = False Then
ID = Me.ContractorLstbx.ItemData(Me.ContractorLstbx.ItemsSelected(i))
Me.SelectedContractorLst.AddItem (ContractorLstbx.Column(0, Me.ContractorLstbx.ItemsSelected(i)) & ";" & Me.ContractorLstbx.Column(1, Me.ContractorLstbx.ItemsSelected(i)))
End If
found = False
Next i
End Sub
I'm trying to write a macro using VBA that will ask a given number of simple arithmetic questions, with each question being available for answer only for a specified amount of time.
I wish to specify somewhere in the worksheet where I can set the parameters of the game (e.g. 20 questions with 12 seconds to answer each) and then click a go button that will continually throw up input boxes every 12 seconds (and remove the previous one at the end of the 12 seconds OR when the person clicks "next" or "ok") until the 20 question quota has been reached, all the while recording the answers and time taken.
I'm quite new to VBA but have made a lot of headway using mostly this site.
So far I have the following which allows me to generate the questions and record the answers:
Sub Rand_Arith()
Dim practice As Workbook
Dim answers As Worksheet
Dim start As Worksheet
Set practice = ActiveWorkbook
Set answers = Sheets("answers")
Set start = Sheets("Start")
Dim x As Variant
Dim a As Variant
Dim b As Variant
Dim answer As Variant
Dim myanswer As Variant
Dim i As Integer
Dim correct As Integer
Dim qs As Integer 'the number of questions we want
Dim spq As Integer 'time in seconds per question
Dim totaltime As Integer
Dim operator As String
qs = start.Cells(3, 3)
spq = start.Cells(2, 3)
totaltime = spq * qs
correct = 0
If answers.Range("A1").Value = "" Then
i = answers.Range("A2").End(xlDown).Row
Else
i = 1
End If
Do Until i = qs + 1
x = Rnd
op = Int(x * 4) '0+ 1- 2* 3/
If x < 0.25 Then
a = Round(Rnd * 10, 2)
b = Round(Rnd * 10, 2)
theanswer = Round(calc(a, b, op), 2)
ElseIf x < 0.5 Then
a = Round(Rnd * 10, 2)
b = Round(Rnd * 10, 2)
theanswer = Round(calc(a, b, op), 2)
ElseIf x < 0.75 Then
a = Round(Rnd * 10, 0)
b = Round(Rnd * 10, 0)
theanswer = Round(calc(a, b, op), 1)
Else:
a = Round(Rnd * 10, 0)
b = Round(Rnd * 10, 0)
theanswer = Round(calc(a, b, op), 1)
End If
theanswer = Round(calc(a, b, op), 2)
operator = s_op(op)
myanswer = Application.InputBox("What is " & a & operator & b & " = ?")
If theanswer = myanswer Then
correct = correct + 1
End If
runningscore = correct / i
answers.Cells(i + 1, 1) = i
answers.Cells(i + 1, 2) = a
answers.Cells(i + 1, 3) = operator
answers.Cells(i + 1, 4) = b
answers.Cells(i + 1, 5) = theanswer
answers.Cells(i + 1, 6) = myanswer
answers.Cells(i + 1, 7) = runningscore
i = i + 1
Loop
End Sub
These are the function's i've made calls to:
Function calc(n1, n2, op)
If op = 0 Then calc = n1 + n2
If op = 1 Then calc = n1 - n2
If op = 2 Then calc = n1 * n2
If op = 3 Then calc = n1 / n2
End Function
Function s_op(op)
If op = 0 Then s_op = "+"
If op = 1 Then s_op = "-"
If op = 2 Then s_op = "*"
If op = 3 Then s_op = "/"
End Function
One problem I am having is that the answer that i put into the input box returns a string which, even when the values are the same, doesn't seem to register as the same as the actual answer calculated by theanswer. As a result the correct and runnningscore variables remain as 0 throughout.
I can't work out how to do the timing part. I've experimented with the following countdown timer which I've taken more or less word for word from this video: https://www.youtube.com/watch?v=sbJeGG_Xv8M
First piece of code:
Sub starttimer()
Application.OnTime Now + TimeValue("00:00:01"), "nexttick"
End Sub
Second Piece
Sub nexttick()
Dim practice As Workbook
Dim start As Worksheet
Set practice = ActiveWorkbook
Set start = Sheets("Start")
If start.Range("c4").Value = 0 Then Exit Sub
start.Range("c4").Value = start.Range("c4").Value - TimeValue("00:00:01")
If start.Range("c4").Value <= TimeValue("00:00:05") Then
start.Shapes("TextBox 3").Fill.ForeColor.RGB = RGB(255, 0, 0)
ElseIf start.Range("c4").Value <= TimeValue("00:00:10") Then
start.Shapes("TextBox 3").Fill.ForeColor.RGB = RGB(0, 0, 255)
ElseIf start.Range("c4").Value <= TimeValue("00:00:15") Then
start.Shapes("TextBox 3").Fill.ForeColor.RGB = RGB(0, 255, 0)
End If
starttimer
End Sub
Lastly:
Sub stoptimer()
On Error Resume Next
Application.OnTime Now + TimeValue("00:00:01"), "nexttick", , False
End Sub
I've not had much success here. I feel as though the countdown macros do not allow for another macro to be run alongside it?
I've also been trying to work with the Application.Wait and Application.OnTime but can't really workout how to combine the question generator I've already made with something that does even something remotely like what what I want to do.
I'm worried that I've dived into this and perhaps its not possible to do what I want with VBA (or that it is actually very difficult).
In any case, and help/constructive criticism would be great!
Furthermore, any more general opinion/advice on my approach to the problem/technique would be greatly appreciated! As mentioned, I'm only just starting out and have no experience in other languages either.
Denis,
I'm going to give you some general advise about how to complete your project, then I'll try to answer some of the specific problems you're having. Before I do that, rest assured that VBA is more than capable accomplishing your task, and, based on the code you've presented you're not in over your head.
General Advice
What you really need here Denis is a UserForm. In your IDE (the place where your code is) go to Insert > UserForm. If you cannot already see it, go to View > Toolbox. There you will see a number of controls (like buttons and text boxes) that you can drag on to your form. You can edit the code behind each control by double clicking it. So, for instance, double clicking the button control will allow you to write code that executes when the user clicks the button.
I'll leave you to figure out the rest of the controls, but using a form will give you the type of control over user interactions that I think you're after. Is it possible to do it without a Userform? Sure, but I wouldn't recommend it.
General Layout
Years ago I wrote a project very similar to yours. I set it up with a Textbox (or label) for the question, a Textbox for the user's answer, a Submit button, and a Cancel button to quit. Clicking the submit button performed the calculations and also triggered the next question.
Timing
VBA has a built in DateDiff function:
DateDiff("s", "06/27/2016 16:42:51", Now())
The first parameter, "s", denotes the unit of time. In this case seconds. In my project the only time I was interested in was the time it took the user to answer the question. For that I stored Now() in a variable at the time the question was presented and compared that to the time when the user clicked Submit using the DateDiff function. You could use it just as easily in your case to limit the duration of the quiz.
Integer Comparisons
VBA is what we call a loosely typed language, meaning that more often than not the interpreter will figure out for you whether your variables are strings or integers, or something else. That being said, some things to keep in mind.
1) It's good practice and safer to declare your variables: Dim theanswer as Integer or Dim theanswer as Double , which ever the case. Often, that will help eliminate the possibility that VBA is treating theanswer as a string and myanswer as an integer and trying to compare the two.
2) If you're pulling values from a cell in your worksheet to compare, make sure and pull Cells(x,y).value.
3) Make sure to use Debug.Print from time to time to check that the values being compared are actually what you expected. For example, Debug.print theanswer. The output from that statement can be seen in the "Immediate" window which can be enabled from the View menu.
Hopeful this will help give you some guidance with the rest of your project. I'll keep an eye on this post, so feel free to post follow up questions as they come to you. Good luck!
I'm creating a program to calculate the average. There are 12 TextBox and I want to create the possibility to leave some fields blank. Now there are only errors and the crash of the program. Is possible to create that?
This is part of code:
ItalianoScritto = (TextBox1.Text)
MatematicaScritto = (TextBox2.Text)
IngleseScritto = (TextBox3.Text)
InformaticaScritto = (TextBox4.Text)
ScienzeScritto = (TextBox5.Text)
FisicaScritto = (TextBox6.Text)
MediaScritto = (ItalianoScritto + MatematicaScritto + IngleseScritto + InformaticaScritto + ScienzeScritto + FisicaScritto) / 6
Label10.Text = Str(MediaScritto)
If i leave blank the textbox1 when I click on the button to calculate the average Vb says Cast not valid from the string "" to type 'Single' and the bar of te textbox1 become yellow
I would do the following:
Iterate over the textboxes and check if you can parse the value into an iteger. If yes, add it to a value list.
Then add all values from that list and divide it by the number of cases.
It is faster than big if-statements and resilient against error
dim TBList as new list(of Textbox)
'add your textboxes to the list here
TbList.add(Textbox1)
...
dim ValList as new List(Of Integer)
for each elem in Tblist
dim value as integer
If integer.tryparse(elem.text,value)=True
ValList.add(Value)
else
'report error or do nothing
end if
next
dim Result as Integer
Dim MaxVal as Integer =0
for each elem in ValList
Maxval +=elem
next
Result = MaxVal / ValList.count
If you need support for point values, just choose double or single instead of Integer.
Also: regardless what you do -CHECK if the values in the textboxes are numbers or not. If you omit the tryparse, somebody will enter "A" and your app will crash and burn
Also: You OPTION STRICT ON!
You just have to check if the TextBox is blank on each one before using the value:
If TextBox7.TextLength <> 0 Then
'Use the value inside
End If
The way to do it depends a lot of your code. You should consider editing your question giving more information (and code) in order to us to help you better.