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?
Related
I'm trying to check whether the main string contains the entire substring, even if there are interruptions.
For example:
main string = 12ab34cd,
substring = 1234d
should return a positive, since 1234d is entirely contained in my main string, even though there are extra characters.
Since InStr doesn't take wildcards, I wrote my own VBA using the mid function, which works well if there are extra characters at the start/end, but not with extra characters in the middle.
In the above example, the function I wrote
works if the main string is ab1234dc,
but not if it's 12ab34cd.
Is there a way to accomplish what I'm trying to do using VBA?
Note Both of the methods below are case sensitive. To make them case insensitive, you can either use Ucase (or Lcase) to create phrases with the same case, or you can prefix the routine with the Option Compare Text statement.
Although this can be done with regular expressions, here's a method using Mid and Instr
Option Explicit
Function ssFind(findStr, mainStr) As Boolean
Dim I As Long, J As Long
I = 1: J = 1
Do Until I > Len(findStr)
J = InStr(J, mainStr, Mid(findStr, I, 1))
If J = 0 Then
ssFind = False
Exit Function
End If
I = I + 1: J = J + 1
Loop
ssFind = True
End Function
Actually, you can shorten the code further using Like:
Option Explicit
Function ssFind(findStr, mainStr) As Boolean
Dim I As Long
Dim S As String
For I = 1 To Len(findStr)
S = S & "*" & Mid(findStr, I, 1)
Next I
S = S & "*"
ssFind = mainStr Like S
End Function
Assuming you have 3 columns "SUBSTR","MAIN" and "CHECK" and your "Substring" data range is named "SUBSTR"
Sub check_char()
Dim c As Range
For Each c In Range("SUBSTR")
a = 1
test = ""
For i = 1 To Len(c.Offset(0, 1))
If Mid(c.Offset(0, 1), i, 1) = Mid(c, a, 1) Then
test = test & Mid(c.Offset(0, 1), i, 1)
a = a + 1
End If
Next i
If test = c Then
c.Offset(0, 2) = "MATCH"
Else
c.Offset(0, 2) = "NO MATCH"
End If
Next
End Sub
I am working on a code that should calculate simple foundations, and in order to do that I have to return 2 values with my function -preferably in two different columns.
Function FundacaoSimples(b, l, carga) As Variant
tensao = Sheets("Tabelas e Constantes").Range("tensao").Value
Dim area As Double
Dim Bs As Single
Dim Ls As Single
Dim Resultado(1 To 2) As String
If b = l Then
area = (1.1 * carga) / tensao
Bs = Sqr(area)
Ls = Bs
ElseIf b <> l Then
area = (1.1 * carga) / tensao
Bs = Sqr((2 * area) / 3)
Ls = (3 * Bs) / 2
End If
Resultado(1) = Round(Bs, 2)
Resultado(2) = Round(Ls, 2)
FundacaoSimples = (Resultado(1) & " / " & Resultado(2))
End Function
This rounding I am using it just to get a value rounded with 2 decimals, e.g: 2,73 to 2,75; 0,89 to 0,90.
I tried working with ActiveCells.Offset(0,1), but the statement isn't valid.
Is it possible to to just jump one column to the right?
You could use ActiveCell.Offset(0, 1).value = SomeValue, however - That's when writing a regular Sub. You're writing a Function / User Defined Function.
Within a UDF it is not possible to alter different cells.
However, a workaround is to have the UDF and when it's entered in a cell, you can then use the Worksheet_Change event to alter the cell next to the Target parameter of that event.
Edit:
Some sample code:
In a regular module:
Public Function MyUDF(param1 as integer, param2 as integer) as Integer
MyUDF = param1 + param2
End Function
In the Worksheet where you want the offset:
Private Sub Worksheet_Change(Byval Target as Range)
If Left(Target.Formula, 6) = "=MyUDF" Then
Target.Offset(0, 1).value = "somevalue at the offset cells"
End If
End Sub
In general, functions should not be writing values or accessing values from a spreadsheet. They should access their parameters and return result.
Try like this, an oversimplified version of what you need:
Option Explicit
Public Sub TestMe()
ActiveCell = FundacaoSimples(0)
ActiveCell.Offset(0, 1) = FundacaoSimples(1)
End Sub
Function FundacaoSimples() As Variant
ReDim varResult(1)
varResult(0) = 55
varResult(1) = 100
FundacaoSimples = varResult
End Function
Then you can edit the function a bit with your own parameters and use it further.
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 writing an IF-THEN-ELSE statement with 19 OR statements contained within it. Is there a way to use word wrap to make it easier to see what I'm coding? Or is there some way to make this more doable? It's very difficult to keep track of all of the statements.
Note: I am not trying to use the Wrapandfit() function or any other function to modify cells, I am talking about the VBA window itself.
An example of the statement:
If InStr(1, Cells(i, 1).Value, "Administration") > 0 Or InStr(1, Cells(i, 1), "Administrative") > 0 Or InStr(1, Cells(i, 1), "Administrator") > 0 Or InStr(1, Cells(i, 1), "Assistant") > 0 Or InStr(1, Cells(i, 1), "Coordinator") > 0 Then
Cells(i, 2).Value = "Administrative"
This matters partly because I can't just make everything on a separate line and delete the line breaks later because of the debugger (which also takes extra work to disable).
You can use the line continuation character _:
Function SmallPrime(n As Integer) As Boolean
If n = 2 Or n = 3 Or n = 5 Or n = 7 _
Or n = 11 Or n = 13 Or n = 17 _
Or n = 19 Then
SmallPrime = True
Else
SmallPrime = False
End If
End Function
Note the space before the _
On edit:
If you want genuine word wrap on the editor level, you can keep an open copy of TextPad with wordwrap enabled and the VBA syntax highlighting definitions available from their website and then copy-paste into the VBA editor. (Notepad++ probably has similar functionality, though Textpad is what I am familiar with).
Use the "_" character
IF this
OR this _
OR this _
OR this _
THEN this
You can always create a separate function and put your 19 OR statements within the function. If you give the function a meaningful name, then your IF statement will become much clearer. (Unless you've got a massively long list of parameters for the function).
Here is an example:
Sub mainCode()
Dim i As Integer
i = 3
If theValueIsOk(i) Then
' do something
Else
' do something else
End If
End Sub
Private Function theValueIsOk(theValue As Integer) As Boolean
Dim result As Boolean
result = False
If theValue = 0 Then
result = True
GoTo Exit_Function
End If
If (theValue = 1) Or (theValue = 3) Then
result = True
GoTo Exit_Function
End If
Exit_Function:
theValueIsOk = result
Exit Function
End Function
I have a really long IF AND OR formula that I'm trying to convert to VBA so it's quicker.
=IF(OR(H10<>"GL402",H10<>"GL412",H10<>"GL422",H10<>"GL432",H10<>"GL442",H10<>"GL452",H10<>"GL492",
H10<>"GL480",H10<>"GL370",H10<>"GL380",H10<>"GL710")*AND(OR(D10<>3,D10<>9,D10<>10),E10<>"ASX",
F10<>"AUD"),"F126",(IF(OR(H2="GL402",H2="GL412",H2="GL422",H2="GL432",H2="GL442",H2="GL452",H2="GL492")*
AND(OR(D2<>"3",D2<>"9",D2<>"10"),E2="ASX",F2="AUD"),"D111",.......))
I thought this should look like:
IF range("H10").Value <>""GL402"" or ""GL412"" or ""GL422"" or ""GL432"" or ""GL442"" _
or ""GL452"" or ""GL492"" or ""GL480"" or ""GL370"" or ""GL380"" or ""GL710"" AND _
range("D10").Value <>3 or 9 or 10 and range("E10").Value <>""ASX"" and _
range("F10").Value <>""AUD""
then
range("I10").Value = ""F126""
elseif
Range("H2").Value = ""GL402"" Or ""GL412"" Or ""GL422"" Or ""GL432"" Or ""GL442"" Or ""GL452"" Or ""GL492"" _
And Range("D2").Value <> 3 Or 9 Or 10 And Range("E2").Value = ""ASX"" And Range("F2").Value = ""AUD""
then
Range("I2").Value = ""D111""
elseif
another lengthy conditions with ANDs and ORs
plus I was hoping to loop this so it applies this whole IF formula until the value of cell A (whichever row) is blank.
I sort of know the loop should be
Do .........
next (with something like A1 + 1)
until A1 + 1 = ""
loop
any help appreciated!
The first rule of good code is that it should be clear - easy to read and debug. Only afterwards do you try to make it "fast". Converting your current expression to VBA may give a speed advantage but you still don't meet the first test...
You can make things cleaner with an expression like this (you can put this right in your spreadsheet):
=ISERROR(MATCH(H10,{"GL402","GL412","GL422","GL432","GL442","GL452","GL492","GL480","GL370","GL380","GL710"},0))
This will evaluate to "true" if the the value in H10 does not match any of the values in the array.
When you have a lot of or conditions in parallel, you can basically stop when the first condition is true.
An expression like that can be written in VBA as follows:
Sub test()
Dim matchStrings
Dim match1, match2
matchStrings = Array("GL402", "GL412", "GL422", "GL432", "GL442", "GL452", "GL492", "GL480", "GL370", "GL380", "GL710")
firstPart = Application.Match(Range("H10"), matchStrings, 0)
If IsError(firstPart) Then
MsgBox "no match found"
Else
match1 = true
MsgBox "match found at index " & firstPart
End If
End Sub
You can repeat similar code with other expressions, building match2, match3, etc - then combining with all the And and Or that you would like - for example
If match1 And (match2 Or match3) Then
... do something
Else
... do something else
End If
This won't work as expected:
If x = 1 Or 2 Or 3 Then
MsgBox "x is either 1, 2, or 3"
End If
because 2 and 3 aren't boolean (true/false) conditions (at least not the way you expect them to be).
The proper syntax is:
If x = 1 Or x = 2 Or x = 3 Then
MsgBox "x is either 1, 2, or 3"
End If
This is only a partial answer that nevertheless does address one of the many issues in your code.