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!
Related
I'm trying to make MATCH function work like FIND function. First of all, I generate the dummy data to be use for testing. Here is the routine I use:
Sub Data_Generator()
Randomize
Dim Data(1 To 100000, 1 To 1)
Dim p As Single
For i = 1 To 100000
p = Rnd()
If p < 0.4 Then
Data(i, 1) = "A"
ElseIf p >= 0.4 And p <= 0.7 Then
Data(i, 1) = "B"
Else
Data(i, 1) = "C"
End If
Next i
Range("A1:A100000") = Data
End Sub
Now, I create a sub-routine to find the string A in the range Data. There are two methods I use here that employ MATCH function. The first method is to reset the range of lookup array like the following code:
Sub Find_Match_1()
T0 = Timer
Dim i As Long, j As Long, k As Long, Data As Range
Dim Output(1 To 100000, 1 To 1)
On Error GoTo Finish
Do
Set Data = Range(Cells(j + 1, 1), "A100000") 'Reset the range of lookup array
i = WorksheetFunction.Match("A", Data, 0)
j = j + i
Output(j, 1) = j 'Label the position of A
k = k + 1 'Counting the number of [A] found
Loop
Finish:
Range("B1:B100000") = Output
InputBox "The number of [A] found are " & k & " in", "Process is complete", Timer - T0
End Sub
And for the second method, I assign the cell of range where A is located by value vbNullString instead of resetting Range("A1:A100000"). The idea is to delete the string A after being found and to expect MATCH function to find the next string A in the Range("A1:A100000"). Here is the code to implement the second method:
Sub Find_Match_2()
T0 = Timer
Dim n As Long, i As Long, j As Long
Dim Data_Store()
Dim Output(1 To 100000, 1 To 1)
Data_Store = Range("A1:A100000")
On Error GoTo Finish
Do
j = WorksheetFunction.Match("A", Range("A1:A100000"), 0)
Output(j, 1) = j
Cells(j, 1) = vbNullString
n = n + 1
Loop
Finish:
Range("A1:A100000") = Data_Store
Range("B1:B100000") = Output
InputBox "The number of [A] found are " & n & " in", "Process is complete", Timer - T0
End Sub
The goal is to determine which method is better at employing MATCH function in its performance. It turns out the first method only completes less than 0.4 seconds meanwhile the second method completes about a minute on my PC. So my questions are:
Why does the second method take time too long to complete?
How does one improve the performance of the second method?
Can MATCH function be used in an array?
I agree that this is more of a Code Review question, but I chose to look into it for my own curiosity, so I'll share what I found.
I think you're hitting a very classic case of N vs N^2 computational complexity. Look at your two methods, which seem remarkably similar, and consider what they're actually doing, keeping in mind that the MATCH function is probably just a linear search when you use Match_type=0 (because your data is unsorted, whereas other match types could do a binary search on your sorted data).
Method 1:
Start at A1
Continue down the range until an "A" is found
Restart at the cell below the MATCH
Method 2:
Start at A1
Continue down the range until an "A" is found
Clear the "A"
Restart at A1
It should be instantly apparent that while one method is continually shrinking the range it searches, the other is always starting at the first cell and searching the whole range. This will account for some of the speedup, and already boosts Method 1 to a nice lead, but it's not even nearly the full story.
The real key lies in the amount of work Match has to do for each situation. Because its range constantly shrinks and moves its start further down the list, whichever cell Method 1's Match starts from, it only has to search a small number of cells before it hits an A and resumes the outer loop. Meanwhile, Method 2 is continually destroying A's, making them less and less dense and forcing itself to search more and more of the range before getting any hits. By the end, Method 2 is looping through almost 100,000 empty cells/B's/C's before finding its next A.
So on average, the Match for Method 1 is only looking through a couple of cells each time, while the Match for Method 2 is taking longer and longer as time goes on, until the end when it is forced to loop through the entire range. On top of that, Method 2 is doing a bunch of writes to cell values, which is slower than you might think when you have to do it tens of thousands of times.
In all honesty, your best bet would be to just loop through the cells yourself once, looking for A's and handling them as you go. MATCH brings no advantage to the table, and Method 1 is basically just a more complicated version of the loop I described.
I'd write this something like:
Sub Find_Match_3()
T0 = Timer
Dim k As Long, r As Range
Dim Output(1 To 100000, 1 To 1)
For Each r In Range("A1:A100000").Cells
If r.Value = "A" Then
Output(r.Row, 1) = r.Row 'Label the position of A
k = k + 1 'Counting the number of [A] found
End If
Next
Range("B1:B100000") = Output
InputBox "The number of [A] found are " & k & " in", "Process is complete", Timer - T0
End Sub
Which is about 30% faster on my machine.
I have a Data Sheet form which has a calculated field column. However the field will not display even though it has the correct value. The field in question is "numRisk":
Sub Calculate_Risk (Form As Object)
Dim OrderPrice, IfDonePrice, TotBrSymComm, BrComm, Risk As Double
Dim Symbol As String
Dim IntRateMult, noContracts As Integer
If MinTick = 0 OR Rate = 0 Then
Exit Sub
End If
Symbol = RTrim(Form.getByName("txtSymbol").CurrentValue)
If Symbol = "" Then
Exit Sub
End If
OrderPrice = Form.getByName("fmtOrder_Price").CurrentValue
IfDonePrice = Form.getByName("fmtIf_Done_Price").CurrentValue
noContracts = Form.getByName("fmtNo_Contracts").CurrentValue
If NOT USIntRates Then
Risk = ABS(OrderPrice - IfDonePrice) / MinTick
Else
Risk = ABS(OrderPrice\1 - IfDonePrice\1) * MinTick
IntRateMult = IIf(Symbol = "FV" OR Symbol = "TU",400, 200)
Risk = ABS(Risk - IntRateMult * ABS(OrderPrice - OrderPrice\1
IfDonePrice + IfDonePrice\1))
End If
Risk = Risk * MinTickVal / Rate
TotBrSymComm = BrSymComm + BrSymCommAud
BrComm = IIf(TotBrSymComm = 0, BrCommission, BrSymCommAud + BrSymComm/Rate)
Risk = noContracts*(Risk + BrComm * 2)
Form.getByName("numRisk").Value = Risk
End Sub
The subroutine is called from the following routine which is triggered when the form is loaded:
Sub FromListForm(Event as Object)
Dim Form As Object
Dim TodaysDate As New com.sun.star.util.Date
Dim CurrDate As Date
Form=Event.Source.getByName("MainForm_Grid")
Form.RowSet.first()
Do Until Form.RowSet.isAfterLast()
Get_Contract(Form)
Get_Broker_Comm(Form)
Calculate_Risk(Form)
If isEmpty(Form.getByName("OrderDate").Date) Then
CurrDate = Date()
TodaysDate.Day = Day(CurrDate)
TodaysDate.Month = Month(CurrDate)
TodaysDate.Year = Year(CurrDate)
Form.getByName("OrderDate").CurrentValue = TodaysDate
End If
Form.RowSet.next()
Loop
Form.RowSet.last()
End Sub
Also is there a more efficient method to cycle through the rows? As this seems so slow I can see the row pointer moving down the table as each row is processed.
If I understand correctly, you're trying to enter individual values into each cell in a column of a tablegrid control? I don't believe that's possible.
Inside a tablegrid control, all values have to come from the underlying query. I recommend writing a query to do these calculations, and using that query as the basis for the form - that would solve both the problem of displaying the calculated result as well as improving the load speed of the form (since database logic in determining query results is almost always more efficient than a macro going row-by-row).
Alternately, you could have the calculated field be standalone, showing only the calculated result for the currently selected row of the tablegrid control. In this scenario, the "form loaded" event would only do the calculation for the first row, and the calculating macro would be triggered each time the row selection changed.
I am trying to set up a userform that will be used to take orders. e.g. each time you click the Cappuccino button it will increment the text box by one indicating that you are ordering 1, 2, 3 etc.
As far as I can get it is to only populate the text box one time. Each additional click does not appear to do anything. This is the Code I currently have for it. I tried declaring num as public. I thought that might be part of the problem but it did not seem to make a difference. Could it be a type casting issue since it is a "text" box and I am trying to treat it as in integer?
Private Sub Capuccino_Click()
If (Cap_qty.Value = Null) Then
Dim num As Integer
num = 1
Cap_qty.Value = Cap_qty.Value + num
ElseIf (Cap_qty.Value = IsNotNull) Then
num = num + 1
Cap_qty.Value = num
'Cap_qty.Value = num + 1
'num = Cap_qty.Value
End If
End Sub
Well, that makes a difference. I looked at something somewhere that told me to use Null, IsNotNull. I was able to get it working with the following which at the moment does not make sense to me I will have to figure out why it works this way. I guess there is some background action happening that is letting me do math with stings
Private Sub CommandButton1_Click()
If (TextBox1.Value = vbNullString) Then
TextBox1.Value = 1
Else
TextBox1.Value = TextBox1.Value + 1
End If
End Sub
I have a long If statement that I am using in multiple for loops and I was wondering if there was a way to shorten my code.
I know in other languages you can store the if statement as a function and call it again and again i.e. Function age() then call it age(), but when I tried to do that in VBA it didn't work.
Does anyone have any ideas? I am using VBA in Excel.
Thanks Sandra
For Each var In pan8
If (pan2.Item(var) <= 15) And (pan3.Item(var) = "F") Then
If (pan.Item(var) = 21) Then
R21F1 = R21F1 + 1
ElseIf (pan.Item(var) = 22) Then
R22F1 = R22F1 + 1
ElseIf (pan.Item(var) = 23) Then
R23F1 = R23F1 + 1
ElseIf (pan.Item(var) = 24) Then
R24F1 = R24F1 + 1
ElseIf (pan.Item(var) = 25) Then
R25F1 = R25F1 + 1
ElseIf (pan.Item(var) = 26) Then
R26F1 = R26F1 + 1
ElseIf (pan.Item(var) = 27) Then
R27F1 = R27F1 + 1
ElseIf (pan.Item(var) = 28) Then
R28F1 = R28F1 + 1
ElseIf (pan.Item(var) = 29) Then
R29F1 = R29F1 + 1
ElseIf (pan.Item(var) = 31) Then
R31F1 = R31F1 + 1
End If
The code continues for 15 different "If (pan2.Item(var) <= 15) And (pan3.Item(var) = "F") Then"
And I call this long bit of code (which is about 5 pages in word) 4 different times.
So I want to be able to store this in something, a friend suggested a function, to be able to call instead of rewriting it each time.
If I understand correctly, all you're really asking is the syntax for calling functions/procedures in VBA.
To call a procedure in VBA, you simply refer to its name, without the parentheses; so Sub Foo() can be called/executed like this:
Foo
If Foo had parameters, say Sub Foo(ByVal bar As String), then you just add the arguments after the procedure's name (separated by commas if there's more than one):
Foo "bar"
Now, say you want the procedure to return a value, and that you want to use that value at the call site, you'd use a function instead: Function Foo(ByVal bar As String) As Boolean
And call it with parentheses:
Dim result As Boolean
result = Foo("bar")
If the function has no parameters, the parentheses are optional.
Using parentheses when calling a Sub, is illegal syntax.
You can definitely store your code in a function or another sub (are the variables called R22F1, R32F1 etc. or you maybe mean Range("R22F1")?).
Please note that I'm using a "Sub" rather than a function, since (whatever R22F1, R23F1 etc. are) you want to automatize an action and not return a value. Assuming that they are code variables:
Sub Main()
MyLongProcedure MyParameter
End Sub
Sub MyLongProcedure(ByVal MyParameter As Integer)
Select Case MyParameter
Case 21:
R21F1 = R21F1 + 1
Case 22:
R22F1 = R22F1 + 1
End Select
End Sub
Please note that you will be able to call the "MyLongProcedure" as many times as you want, without copying and pasting the code but just writing Call MyLongProcedure()and passing in it the parameter you want to evaluate to perform the actions accordingly.
MOREOVER
If they are ranges named like that, seen the connection between the number you evaluate and the variable in your sample code, why you don't just write a statement of kind Range("R" & pan & "F1") = Range("R" & pan & "F1") + 1 without need to check with an if or a select case?
I'm attempting to graph lnD and i, where i is the x-axis, and lnD is the y-axis. I have an equation that I'm putting a range of values for i into, and attempting to retrieve values of lnD.
However, I came across an odd issue. First off, here is the code. I should note that it causes my Excel to freeze up for a few seconds, but it doesn't crash or anything.:
Tracker = 0
Alpha = -1.593975
Beta = -334.6942
For i = 0 To 0.1 Step 0.01
Tracker = Tracker + 1
lnD = Beta * i + Alpha
Range("XFB" & Tracker).Value = i
Range("XFC" & Tracker).Value = lnD
Next i
I get the error "Method 'Range' of object '_Global' failed". And when I look at the columns where the data should be, it is just i = 0 and lnD = -1.593975, repeating over and over again. When I look at the value of Tracker, it has increased into the 10 thousands, and since all of the columns are full to the bottom of excel, that means the loop is actually looping. But why is i getting stuck at zero, and not increasing? Why am I getting this error?
EDIT: I should note that if you change the top line to For i = 0 to 10 step 1, it works... So does this have to do with the numbers I'm putting in?
EDIT 2: So, after getting advice that it's an error not present in the code I put here, I looked into my variable declarations. The issue ended up being that I declared i as an integer! That made it round down to zero, causing the loop to get stuck at i = 0, and never making it to a "stopping point". Just a silly mistake!
I'm not going to delete this post, only because I feel like I should put my stupidity on display. Thank you for helping, everyone!
Your code does work on my PC (after changing the columns to "A" and "B" as I'm working in Excel 2010 and my columsn don't run up all the way to where you're writing to). Your comments seem to be indicating that your actually looping over a lot more values for i than you're stating ("Tracker is in the 10,000s while i only goes through 10 steps), can something there cause a problem?
As an aside, writing single cells values to excel is very unlikely to be efficient. A lot quicker will be writing everything into an array and then writing the array to excel.
What works on my excel is (please note that I change the start of the output to "A1", be careful you don't overwrite any data):
Sub test()
' Parameters
Dim Alpha#: Alpha = -1.593975
Dim Beta#: Beta = -334.6942
Dim nmbOfSteps&: nmbOfSteps = 11&
Dim increment#: increment = 0.01
Dim startValue#: startValue = 0#
' Fill in values in an array
Dim result() As Double, cntr&
ReDim result(1 To nmbOfSteps, 1 To 2)
For cntr = 1 To nmbOfSteps
Dim iValue#: iValue = startValue + CDbl(cntr - 1&) * increment
result(cntr, 1) = iValue
result(cntr, 2) = Alpha + Beta * iValue
Next cntr
' Write the entire array in one go
ThisWorkbook.ActiveSheet.Range("A1").Resize(nmbOfSteps, 2).Value2 = result
End Sub
Try the following. Rather than moving the target range, I always find it better to fix on the top of my trget and use offset to populate the cells bwllow and to the right.
Sub testit()
Dim StartCell As Range
tracker = 0
Alpha = -1.593975
Beta = -334.6942
Set StartCell = ActiveSheet.Range("XFB1")
For i = 0 To 0.1 Step 0.01
lnD = Beta * i + Alpha
StartCell.Offset(tracker, 0).Value = i
StartCell.Offset(tracker, 1).Value = lnD
tracker = tracker + 1
Next i
End Sub