VBA and Cases, assigning value based off of value in a range - vba

I have grades for students and levels of proficiency.
for example, for 5th grade, there are four levels of proficiency. The four levels of proficiency correspond to letters of the alphabet, so if a 5th grader got a letter assignment of B, then his proficiency level would be "Below Proficient" since for any letter in A to R would get a level of "Below Proficient" I was wondering how to do this with cases,
My rough idea of code was the following:
Function ConvertScores(Grade, Letter_Score)
Select Case ConvertScore(5, like "[A-R]")
Case ConvertScore(5, like"
ConvertScores = "F & P Remedial"
Case 2
ConvertScores = "F & P Below Proficient"
Case 3
ConvertScores = "F & P Proficient"
Case 4
ConvertScores = "F & P Advanced"
End Function
So yea, I wish VBA had a list object, what is the list object in VBA?
EDIT: I was able to do it with multiple If statements, but it seems to me that cases would have been a better way to go.
Here is my code that I want to use with cases instead of multiple if-thens
Function ConvertScoresMOY(Grade, Letter_Score) As String
If Grade = "5" And Letter_Score Like "[A-R]" Then
ConvertScoresMOY = "F & P Remedial"
ElseIf Grade = "5" And Letter_Score Like "[S-T]" Then
ConvertScoresMOY = "F & P Below Proficient"
ElseIf Grade = "5" And Letter_Score Like "[U-V]" Then
ConvertScoresMOY = "F & P Proficient"
ElseIf Grade = "5" And Letter_Score Like "[W-Z]" Then
ConvertScoresMOY = "F & P Advanced"
Else:
End If
End Function

Lets just start from insert all the conditions in one simple condition:
If Grade = "5" Then
End If
then you can use SWITCH CASE:
Select Case Letter_Score
Case Letter_Score Like "[A-R]"
ConvertScoresMOY = "F & P Remedial"
Case val Letter_Score Like "[S-T]"
ConvertScoresMOY = "F & P Below Proficient"
End Select

You could create your dictionary in another sheet, then use the VLOOKUP() function to search for a value on the first column and get the value on the second.

Related

SQL Select query in VB.NET

I want to pull some stuff out of a database using a select query. I have the query i need already written in SQL Server management studio and it works. I tried just copy it in but it doesn't work. I have some other queries that do work and i tried to make it formatted like those, but it'll just see it as string since its between "" those things.
Below is the query, it uses the join function that doesn't appear to be recognized by vb.net. the query also uses certain tables from other parts of the database, those also dont seem to get recognized.
the query:
select th.Thickness, count(th.Thickness)
from dbname..trackinghistory th
join dbname..OrderDetailOptions odo on odo.odKey=th.odKey
join dbname..MasterPartOptions mpo on mpo.Code=odo.OptionCode and mpo.[Group]=odo.optiongroup
and mpo.QuestionKey='KGLASS' and OptionType=5
where th.DateTime>DATEADD(DAY,-4,getdate()) and th.Code='__A__' and th.StationID='HO4' and
left(odo.OptionCode,1) = 'H'
group by th.Thickness
I think i just need a push in the right direction, can someone here help me with how to properly format these type of queries?
my VB.Net code:
Sub SetButtonColor()
btnIsClicked = False
Dim iWeek As Integer = tbWeek.Text
Dim iYear As Integer = tbYear.Text
If sql.hasconnection And iWeek <> 0 Then
Dim dtimeStartDate As DateTime = GetWeekStartDate(tbWeek.Text, tbYear.Text) 'get the startdate from the textboxes week and year
Dim dtimeEndDate As DateTime = DateAdd(DateInterval.Day, 7, dtimeStartDate) 'add 7 days to the startdate to set the enddate
sql.runquery("SELECT th.Thickness, count(th.Thickness)" +
"from FVMASTER..trackinghistory th" +
"join FVMASTER..OrderDetailOptions odo on odo.odKey=th.odKey" +
"join FVMASTER..MasterPartOptions mpo on mpo.Code=odo.OptionCode and mpo.[Group]=odo.optiongroup and mpo.QuestionKey='KGLASS' and OptionType=5" +
"where th.DateTime>DATEADD(DAY,-4,getdate()) and th.Code='__A__' and th.StationID='HO4' and left(odo.OptionCode,1) = 'H'" +
"group by th.Thickness")
If sql.sqldataset.Tables(0).Rows.Count > 0 Then
For Each row As DataRow In sql.sqldataset.Tables(0).Rows
Select Case row("Thickness")
Case 3
btn3.BackColor = Color.Red
Case 4
btn4.BackColor = Color.Red
Case 5
btn5.BackColor = Color.Red
Case 6
btn6.BackColor = Color.Red
Case 8
btn8.BackColor = Color.Red
Case 10
btn10.BackColor = Color.Red
Case 12
btn12.BackColor = Color.Red
Case 15
btn15.BackColor = Color.Red
Case 19
btn19.BackColor = Color.Red
Case 24
btn24.BackColor = Color.Red
End Select
Next
End If
end sub
i have for now just pasted in the query, i know that that wont work
The problem are the missing spaces in the SQL string. Just because the concatentated strings are on different lines, this does not add line breaks to the string.
E.g.,
"from FVMASTER..trackinghistory th" +
"join FVMASTER..OrderDetailOptions odo on odo.odKey=th.odKey"
results in
"from FVMASTER..trackinghistory thjoin FVMASTER..OrderDetailOptions odo on odo.odKey=th.odKey"
As you can see, you get a thjoin in there, which should be th join.
Just write it as a single multiline string (which now includes the line breaks)
sql.runquery("SELECT th.Thickness, count(th.Thickness)
from FVMASTER..trackinghistory th
join FVMASTER..OrderDetailOptions odo on odo.odKey=th.odKey
join FVMASTER..MasterPartOptions mpo on mpo.Code=odo.OptionCode and mpo.[Group]=odo.optiongroup and mpo.QuestionKey='KGLASS' and OptionType=5
where th.DateTime>DATEADD(DAY,-4,getdate()) and th.Code='__A__' and th.StationID='HO4' and left(odo.OptionCode,1) = 'H'
group by th.Thickness")
Alternatively, you can keep your original approach and add the missing spaces at the line end
sql.runquery("SELECT th.Thickness, count(th.Thickness) " +
"from FVMASTER..trackinghistory th " +
"join FVMASTER..OrderDetailOptions odo on odo.odKey=th.odKey " +
"join FVMASTER..MasterPartOptions mpo on mpo.Code=odo.OptionCode and mpo.[Group]=odo.optiongroup and mpo.QuestionKey='KGLASS' and OptionType=5 " +
"where th.DateTime>DATEADD(DAY,-4,getdate()) and th.Code='__A__' and th.StationID='HO4' and left(odo.OptionCode,1) = 'H' " +
"group by th.Thickness")

Is there a way to optimize nested if clauses?

for a while now I've tried to solve the decreased speed issue in my Access application when opening a print preview of certain reports. I've noticed that the slow reports have one thing in common - long, nested if clauses. I tried to search the internet for an answer for this issue, but some of the solutions do not apply to Access VBA or they just aren't possible to implement in the case of my application.
I was wondering if there are some commonly known ways that are used in order to avoid if clause monsters?
EDIT: A snip of code - it mostly handles the structure of the report based on certain conditions.
If (strCcDocNumber <> vbNullString) Then
Dim strUpperPart As String, strLowerPart As String
IDModule.placeIDStringsToPrivateVariables strCcDocNumber, ", "
strUpperPart = IDModule.returnUpper()
strLowerPart = IDModule.returnLower()
txtIDs = strUpperPart & vbCrLf & strLowerPart
Else
txtIDs = " " & vbCrLf & " "
End If
If (strOrderNumber = IO_OrderNumber.OrderNumberCode & "12345") Then
txtIDs = txtIDs
txtIDSpec1 = ModuleIDSpec1.getIDSpec1
txtIDSpec2 = ModuleIDSpec2.getIDSpec2
txtIDSpec1.Height = 330
txtIDSpec2.Height = 330
txtUpperLower = "- Ex" & vbCrLf & "- Ex2" & vbCrLf & vbCrLf & "- Ex3"
On Error Resume Next
For Each c In Me.Controls
If (c.Tag = "IDSpec2Table" Or c.Tag = "IDSpec1Table") Then c.Height = 0
If (c.Tag = "IDSpec2Table" Or c.Tag = "IDSpec1Table") Then c.Visible = False
If (c.Tag = "IDSpec2Table" Or c.Tag = "IDSpec1TableExtra") Then c.Height = 0
If (c.Tag = "IDSpec2Table" Or c.Tag = "IDSpec1TableExtra") Then c.Visible = False
If (c.Tag = "IDSpec2Texts" Or c.Tag = "IDSpec1Texts") Then c.Visible = True
If (c.Tag = "IDSpec2Texts" Or c.Tag = "IDSpec1Texts") Then c.Height = 330
If (c.Tag = "IDSpec2Texts" Or c.Tag = "IDSpec1TextsExtra" And ModuleTarget.TargetGroup <> "23C") Then c.Visible = True
If (c.Tag = "IDSpec2Texts" Or c.Tag = "IDSpec1TextsExtra" And ModuleTarget.TargetGroup <> "23C") Then c.Height = 330
'+ many more tags
Next
On Error GoTo 0
txtIDSpec1.Visible = True
txtIDSpec2.Visible = True
If (txtIDSpec1 = vbNullString And txtIDSpec2 = vbNullString) Then
txtIDSpec1.Height = 0
txtIDSpec2.Height = 0
txtIDSpec1.Visible = False
txtIDSpec2.Visible = False
End If
Else
'+a lot more similar conditions
EDIT: I remembered which if statements were the most troublesome ones. I think you can't change these ones into select cases or ElseIf statements, because all of the conditions need to be checked...
It goes like this:
If (condition) Then
Do this
If (differentCondition) Then
Do this also
If (completelyDifferentCondition) Then
Do this as well
Else
Do this instead
End If
End If
Else
If (yetAnotherCondition) Then
Do this
Else
Do this instead
End If
End If
I was wondering if there are some commonly known ways that are used in
order to avoid if clause monsters?
First step is to work out what you want to achieve, not how you want to do it. In this context, you want to set height and visibility. From here, you can work out what conditions are required to set this.
When you first do this, you will have some monster clauses - but this is OK because you have not clarified your thinking. Work from an assumption of one state unless proven otherwise. Here is an example:
c.visible = True
If ((c.Tag = "IDSpec2Table" Or c.Tag = "IDSpec1Table") OR (c.Tag = "IDSpec2Table" Or c.Tag = "IDSpec1TableExtra")) then c.visible = True
Of course, the second line can now be simplified a little bit.
If (c.Tag = "IDSpec2Table" Or c.Tag = "IDSpec1Table" Or c.Tag = "IDSpec1TableExtra") then c.visible = True
I also I set marker Booleans - for example:
IsSpecTable = (c.Tag = "IDSpec2Table" Or c.Tag = "IDSpec1Table")
IsMySpecialFriend = (c.Tag = "IDSpec1TextsExtra" And ModuleTarget.TargetGroup <> "23C")
[...]
c.Visible = IsSpecTable Or IsMySpecialFriend
These are a couple of techniques I use to simplify complex business logic. I am also looking at the use of flags, but this means converting the text Tag to an enumerated value (I am doing this in VB.Net). This technique, though, simplifies the expression down to a simple mask with a And or Or operator as appropriate.
Consider using Select Case Statements when you have multiple If Statement based off the same value.
MSDN - Select Case Statement
Executes one of several groups of statements, depending on the value of an expression.
For Each c In Me.Controls
Select Case c.Tag
Case "IDSpec2Table", "IDSpec1Table", "IDSpec1TableExtra"
c.Height = 0
c.Visible = False
Case "IDSpec2Texts", "IDSpec1Texts"
c.Visible = True
c.Height = 330
Case "IDSpec1TextsExtra"
If ModuleTarget.TargetGroup <> "23C" Then
c.Visible = True
c.Height = 330
End If
End Select
Next
Performance: Select Case vs If vs If ElseIf
I mentioned in a comment that using a Select Case is more for readability than performance. Which is correct if we are comparing Select Case and If ElseIf statements (read Which way is faster? If elseif or select case).
Select Case and If ElseIf can be considerably faster than multiple If statements. This is because the VBA evaluates every condition in an If statement and will stop evaluating when one condition is meet in the Select Case statement. Note: not all languages do.
Consider this simple test.
Sub Test()
Debug.Print "Test:If Statement Test:"
If ret(1) = 1 Or ret(2) = 2 Or ret(3) = 3 Or ret(4) = 4 Or ret(5) = 5 Then
End If
Debug.Print vbNewLine; "Test:If ElseIf Statement"
If ret(1) = 1 Or ret(2) = 2 Then
ElseIf ret(3) = 3 Then
ElseIf ret(4) = 4 Then
ElseIf ret(5) = 5 Then
End If
Debug.Print vbNewLine; "Test:Select Case Statement"
Select Case 1
Case ret(1), ret(2)
Case ret(3)
Case ret(4)
Case ret(5)
End Select
End Sub
Function ret(n As Long) As Long
ret = n
Debug.Print n,
End Function
Notice that the If statement had to perform 5 operations even though they were all true. The ElseIf had to perform 2 operations because the first 2 operations were grouped in a single If clause. The Select Case only performed a single operation, even though, two operations were grouped together. This is because the Select Case will always stop evaluating conditions when a single condition is true.

Comparing Basic Strings Exponential Complexity

I may be asking a silly question but I am self teaching myself VBA and I am just stumped and I am not even sure what terms I can use to look up a solution.
I am writing a code that will compare three variables to three other variables then I want to display which variables have changed.
So if x = a but y <> b and z <> c then the output should be b/c
I have worked out a code that works fine
Dim Str As String
If X <> A Then
If Y <> B Then
If Z <> C Then
Str = "a/b/c"
Else
Str = "a/b"
End If
ElseIf Z <> C Then
Str = "a/c"
Else
Str = "a"
End If
ElseIf Y <> B Then
If Z <> C Then
Str = "b/c"
Else
Str = "b"
End If
Else
Str = "c"
End If
But as I increase the number of variables this becomes extremely complex very quickly.
If anyone can help direct me to a simpler method without the exponential complexity I would be very grateful.
Thank you all so much!
You need to test each variable pair independently from each other -- not link them together in one giant If construct tree.
Example:
str = "" 'Start with blank string. Append as required.
If x <> a Then str = str & "a/"
If y <> b Then str = str & "b/"
If z <> c Then str = str & "c/"
'Remove the extra / at the end
If Right(str, 1) = "/" Then str = Left(str, Len(str - 1))
You could put the 2 strings in 2 arrays, and then use a FOR...NEXT construct to loop both arrays. You can use UBound(arValues) to dynamically find out the number of items in the array.
Good luck

How to use dash (-) as value for criteria

I don't know if this is possible in MS Access, but what I want to do is detect dash (-) and use Between in SQL statement and or Comma.
Ex. I have a table called "Books" with fields: BookID, Title, Subject.
Now how can I query Books table that allows a user to input a value in a textbox like:
1 or 1-5 or 1,3,4.
If the value is 1 the sql statement should be:
SELECT * FROM Books WHERE BookID = 1
If the value of 1-5 then the sql statement should be:
SELECT * FROM Books WHERE BookID BETWEEN 1 And 5
If the value of 1,3,4 then the sql statement should be:
SELECT * FROM Books WHERE BookID IN (1,3,4)
Cut from something I already have;
s = "SELECT * FROM Books WHERE BookID" & parseSarg("11,22,33")
using;
Public Function parseSarg(str As String) As String
Dim re As Object: Set re = CreateObject("vbscript.regexp")
re.Global = True
Select Case True
'//is number
Case reTest(re, "^\d+$", str): parseSarg = " = " & str
'//is number-number
Case reTest(re, "^\d+-\d+$", str): parseSarg = " BETWEEN " & Replace$(str, "-", " AND ")
'//is number,number[,number]
Case reTest(re, "^\d+(?:,\d+)*$", str): parseSarg = " IN (" & str & ")"
'//is >number
Case reTest(re, "^>\s*\d+$", str): parseSarg = " >" & Mid$(str, 2)
Case Else
parseSarg = " = 0 AND 1=0"
End Select
End Function
Function reTest(re As Object, pattern As String, value As String) As Boolean
re.pattern = pattern
reTest = re.Test(value)
End Function
SELECT Books.Title FROM Books WHERE Books.BookID > 1 AND Books.BookID < 5;

inner loops, procedure call confusion

So what the issue is, i have 2 for loops one nested within another. The outer loop calling a procedure, the inner loop setting a attribute for the procedure to use. The problem is that the procedure is that I wan't to exit the loop use the pos <-- attribute call the procedure and re-enter the inner loop. At the minute the pos is only being set once because all the conditions are true within the inner loop meaning that its being replaced each time. I want to be able to set the pos exit the inner loop, call the procedure and re-enter the inner loop and set it pos to a different value? any help would be great!! here is the code
For Each val As String In vals
If creditPoints = "20" And semester = "1" And year = "Year 1" Then
For Each position In MyPosList
If position.strLabel = "a1" And available(0) <> "False" Then
pos = position.strX & " " & position.strY
count += 1
available(0) = blnavailable
ElseIf position.strLabel = "b1" And available(1) <> "False" Then
pos = position.strX & " " & position.strY
count += 1
available(1) = blnavailable
Next
shortfat(semester, pos, creditPoints, title, year, modStatus, count)
End If
next
Are you just looking to break out of the inner loop when one of those conditions are met? If so, that's what the Exit keyword is for. You really should also set a flag to sanity check yourself, too.
''//Flag so that we know if we actually found a position
Dim FoundPosition as Boolean
For Each val As String In vals
''//Reset the flag and assume that are conditions are met
FoundPosition = False
If creditPoints = "20" And semester = "1" And year = "Year 1" Then
For Each position In MyPosList
If position.strLabel = "a1" And available(0) <> "False" Then
pos = position.strX & " " & position.strY
count += 1
available(0) = blnavailable
''//Flag that our conditions are met
FoundPosition = True
''//Exit from the inner loop
Exit For
ElseIf position.strLabel = "b1" And available(1) <> "False" Then
pos = position.strX & " " & position.strY
count += 1
available(1) = blnavailable
''//Flag that our conditions are met
FoundPosition = True
''//Exit from the inner loop
Exit For
End If
Next
''//Sanity check to ensure that our conditions are met
If FoundPosition Then
shortfat(semester, pos, creditPoints, title, year, modStatus, count)
Else
''//Do something here, either Throw an error or safely handle this case otherwise
End If
End If
Next
"I want to be able to set the pos exit the inner loop, call the
procedure and re-enter the inner loop and set it pos to a different
value?"
Things like that are better served with a WHILE loop than a FOR loop.
Just a stab in the dark here, but it sounds like you want to be able to see if shortfat is producing a favorable value. And if it does not, you want it to recompute pos. The first thing I'd do, is alter shortfat to return some kind of value...for my example, I'll have it return a boolean.
Dim blnDidThisDoWhatIWant As Boolean
For Each val As String In vals
If creditPoints = "20" And semester = "1" And Year() = "Year 1" Then
blnDidThisDoWhatIWant = False
While blnDidThisDoWhatIWant = False
For Each position In MyPosList
If position.strLabel = "a1" And available(0) <> "False" Then
pos = position.strX & " " & position.strY
count += 1
available(0) = blnavailable
ElseIf position.strLabel = "b1" And available(1) <> "False" Then
pos = position.strX & " " & position.strY
count += 1
available(1) = blnavailable
End If
Next
blnDidThisDoWhatIWant = shortfat(semester, pos, creditPoints, title, Year, modStatus, count)
End While
End If
Next
This will allow you to re-enter the inner loop. The problem is that it'll be infinite unless pos is computed differently (which I don't see how it can). So that's something you'll have to work out on your own. Hope this helps point you in the right direction.