Solved: Case Select

[Aussiebear]

As I understand it so far a Case Select may be written as follows:

Select Case DayOfWeek
Case 1
DayName = "Monday"
Case 2
DayName = "Tuesday"
Case 3
DayName = "Wednesday"
Case 4
DayName = "Thursday"
Case 5
DayName = "Friday"
Case 6
DayName = "Saturday"
Case 7
DayName = "Sunday"
Case Else
DayName = "Unknown day"
End SelectWhere the case has a single criteria. Is it possible therefore to write a Case Select where each Case option has a dual criteria?

For example could I write a Case option in the following manner?

Case Select TwoUp
Case "Tom" or "Fred"
Car = "Yellow"
Case "Bill" or "Terry"
Car = Blue
End Select
The reason I ask this that I have a data form which has a text box from which a value (one of twelve) may be entered by the user. Of the twelve there are 6 related pairs.

Example 01 & 01R, 250 & 250R, 500 & 500R etc. ( The R simply indicates a Re-test)

[mdmackillop]

Case "Tom", "Fred"

[Aussiebear]

As in

Case "01, "01R"
If Trim (Right( Me.txtVendorTest.Text)) = "01" or "01R"
Then Cell A1 = "Whatever"

BTW Me.txtVendorTest.Text could be in the format of T2000-23-01 or T2000-23-01R.... Hey, you are supposed to be at work MD?

:ack:

[mdmackillop]

Lunch break!
You're missing a number from the Right function

[Aussiebear]

Yes I know, but since the length of the string can range from 2 to 5, (01 to 2000R) I left it out- for the time being.

[Charlize]

If the codes will always have two - to separate the last 2 to 5 characters of you code, try this
Dim TwoUp As String
Dim A_TwoUp() As String
A_TwoUp = Split(Me.txtVendorTest.Text, "-")
If Right(A_TwoUp(2), 1) = "R" Then
TwoUp = Mid(A_TwoUp(2), 1, Len(A_TwoUp(2)) - 1)
Else
TwoUp = A_TwoUp(2)
End If
Select Case TwoUp
Case "01"
MsgBox "Stripped : " & Me.txtVendorTest.Text & " = " & TwoUp
Case "02"
'...
End SelectCharlize

[mdmackillop]

or, to get the last digits, with or without an R
Sub SplitIt()
test = Replace("1000-21-01R", "-", " ")
MsgBox Split(Split(test)(UBound(Split(test))), "R")(0)
End Sub

[Aussiebear]

G'day Charlize, The section after the 2nd dash willl be used to determine the correct column of a selected row found on the active sheet.

The code as it stands now is

Private Sub cmdAdd_Click()
Dim Tgt As Range, col As Long
Dim Grower As String
Dim Vendor As String
Dim Result As String

On Error Resume Next

Grower = Me.txtGrowerID.Text
Vendor = Me.txtVendorTest.Text
Result = Me.cboResult.Text

' Check for a Grower ID
If Trim(Me.txtGrowerID.Text) = "" Then
Me.txtGrowerID.SetFocus
MsgBox "Please Enter a Grower ID"
Exit Sub
End If

'Get Row Number
Set Tgt = Cells(ActiveSheet.Columns(2).Find(What:=Grower, lookat:=xlWhole).Row, 1)

'Check for Blanks
col = Application.WorksheetFunction.CountBlank(Tgt.Range("J1:L1"))
Select Case col
Case 0
Tgt.Range("K1:L2").Cut Tgt.Range("J1")
Tgt.Range("L1") = Vendor
Tgt.Range("L2") = Result
Case 1
Tgt.Range("L1") = Vendor
Tgt.Range("L2") = Result
Case 2
Tgt.Range("K1") = Vendor
Tgt.Range("K2") = Result
Case 3
Tgt.Range("J1") = Vendor
Tgt.Range("J2") = Result
End Select

'Adjust risk level value for result
Select Case Me.cboResult

Case ">MRL"
Tgt.Range("M1") = 3

Case "<AL", ">AL"
If Tgt.Range("M1") = 0 Then Tgt.Range("M1") = 1
If Tgt.Range("M1") < 3 Then Tgt.Range("M1") = Tgt.Range("I1")
If Tgt.Range("M1") = 3 Then Tgt.Range("M1") = 3


Case "<LOR"
If Tgt.Range("M1") = 0 Then
'No Change
Else
Select Case col
Case Is < 2
If Tgt.Range("K2") = "<LOR" And Tgt.Range("L2") = "<LOR" Then
If Tgt.Range("M1") < 3 Then Tgt.Range("M1") = 0
If Tgt.Range("M1") = 3 Then Tgt.Range("M1") = Tgt.Range("I1")
End If
Case 2
If Tgt.Range("J2") = "<LOR" And Tgt.Range("K2") = "<LOR" Then
If Tgt.Range("M1") < 3 Then Tgt.Range("M1") = 0
If Tgt.Range("M1") = 3 Then Tgt.Range("M1") = Tgt.Range("I1")
End If
'Case 2
' No Change
'Case 3
' No Change
End Select
End If
End Select


' Clear data from form after having written to sheet
Me.txtGrowerID.Value = ""
Me.txtVendorTest.Value = ""
Me.cboResult.Value = ""
Me.lblGrower.Caption = ""
Me.txtGrowerID.SetFocus
'
End Sub

This saves data to a sheet "Risk Levels". In real life, I need the data to be saved to two different sheets and the sheet layouts are different. Where the code ends with the line End Select and starts with 'Clears the data from the form after having written to the sheet, I need to add new code which allows me to change to another sheet, then find the correct row based on a value ( the same as on the origonal sheet).

Then the correct column of the selected row is based upon the value of the third part of the Me.txtVendorTest.Text. In general terms, if the value is "01" or "01R" then another value will be placed in column J of the selected row.

As a consequence of this the relationship will continue, "250" or "250R" in column L, 500 or 500R in Column N, 1000 or 1000R in Column P, 1500 or 1500R in Column R, and 2000 or 2000R in Column T. Once this is done then the data will be cleared from the form.

Complicated I know, and perhaps not espoused correctly, but this is the general direction I am thinking of heading.

[mdmackillop]

Hi Ted,
This code is starting to look a bit daunting (not that it's overcomplicated), but before extending it further, I would be looking to split this into separate subs, eg
CheckForBlanks Tgt
AdjustRiskLevel Tgt
and move the relevant code into these routines. I think you'll find it more manageable.

[Aussiebear]

So in essence whenever constructing code, one should compartmentalise ( nice Aussie word there) the code?

[Bob Phillips]

Functions might be good here, something like


Private Function GetColumn(ByVal Key As String)
Select Case Key
Case "01", "01R": GetColumn = "J"
Case "250", "250R": GetColumn = "L"
Case "500", "500R": GetColumn = "N"
Case "1000", "1000R": GetColumn = "P"
Case "1500", "1500R": GetColumn = "R"
Case "2000", "2000R": GetColumn = "T"
End Select
End Function


and then use like so


Worksheets("abc").Range(GetColumn(Me.txtVendorTest.Text).Value & rownum) = "xyz"


This way you keep a logical placeholder in the mainline code, but offload the deatiled work

[fumei]

Yes absolutely it is better to make your code into manageable chunks, either by Functions, or by Subs.

You will find debugging MUCH easier. It also makes reading code much easier.

[johnske]

Yes absolutely it is better to make your code into manageable chunks, either by Functions, or by Subs.

You will find debugging MUCH easier. It also makes reading code much easier.Also, instead of having a large very very specific procedure that would be difficult to modify for something else, the smaller functions or subs can be saved, and easily modified and re-used for other things...

[Aussiebear]

Will try something at work (if time available) and get back tonight

[Aussiebear]

This is probably taking the "subbing" effect to extremes but is this what you are suggesting?

Private Sub cmdAdd_Click()
Dim Tgt As Range, col As Long
Dim Grower As String
Dim Vendor As String
Dim Result As String

On Error Resume Next

Grower = Me.txtGrowerID.Text
Vendor = Me.txtVendorTest.Text
Result = Me.cboResult.Text

' Check for a Grower ID
If Trim(Me.txtGrowerID.Text) = "" Then
Me.txtGrowerID.SetFocus
MsgBox "Please Enter a Grower ID"
Exit Sub
End If
End Sub

Sub RowNum1()

'Get Row Number
Set Tgt = Cells(ActiveSheet.Columns(2).Find(What:=Grower, lookat:=xlWhole).Row, 1)
End Sub

Sub CheckBlanks()
'Check for Blanks
col = Application.WorksheetFunction.CountBlank(Tgt.Range("J1:L1"))
Select Case col
Case 0
Tgt.Range("K1:L2").Cut Tgt.Range("J1")
Tgt.Range("L1") = Vendor
Tgt.Range("L2") = Result
Case 1
Tgt.Range("L1") = Vendor
Tgt.Range("L2") = Result
Case 2
Tgt.Range("K1") = Vendor
Tgt.Range("K2") = Result
Case 3
Tgt.Range("J1") = Vendor
Tgt.Range("J2") = Result
End Select
End Sub

Sub AdjustRisk()
'Adjust risk level value for result
Select Case Me.cboResult

Case ">MRL"
Tgt.Range("M1") = 3

Case "<AL", ">AL"
If Tgt.Range("M1") = 0 Then Tgt.Range("M1") = 1
If Tgt.Range("M1") < 3 Then Tgt.Range("M1") = Tgt.Range("I1")
If Tgt.Range("M1") = 3 Then Tgt.Range("M1") = 3


Case "<LOR"
If Tgt.Range("M1") = 0 Then
'No Change
Else
Select Case col
Case Is < 2
If Tgt.Range("K2") = "<LOR" And Tgt.Range("L2") = "<LOR" Then
If Tgt.Range("M1") < 3 Then Tgt.Range("M1") = 0
If Tgt.Range("M1") = 3 Then Tgt.Range("M1") = Tgt.Range("I1")
End If
Case 2
If Tgt.Range("J2") = "<LOR" And Tgt.Range("K2") = "<LOR" Then
If Tgt.Range("M1") < 3 Then Tgt.Range("M1") = 0
If Tgt.Range("M1") = 3 Then Tgt.Range("M1") = Tgt.Range("I1")
End If
'Case 2
' No Change
'Case 3
' No Change
End Select
End If
End Select
End Sub

Sub ClearData()
' Clear data from form after having written to sheet
Me.txtGrowerID.Value = ""
Me.txtVendorTest.Value = ""
Me.cboResult.Value = ""
Me.lblGrower.Caption = ""
Me.txtGrowerID.SetFocus
End Sub

Private Sub txtGrowerID_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim c As Range
Set c = Columns(2).Find(txtGrowerID)
If c Is Nothing Then
MsgBox "Please check ID number"
Cancel = True
txtGrowerID = ""
End If
End Sub

Private Sub txtGrowerID_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim c As Range
Set c = Columns(2).Find(txtGrowerID)
lblGrower.Caption = c.Offset(, -1)
ActiveWindow.ScrollRow = c.Row
End Sub

Private Sub txtVendorTest_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim c As Range
Set c = Columns("J:L").Find(txtVendorTest.Text)
If Not c Is Nothing Then
MsgBox "Test No. exists in Cell " & c.Address(0, 0)
Cancel = True
End If
End Sub

Private Sub cmdClose_Click()
Unload Me
End Sub

If I follow this principle then the main body needs to be structured like?
(At this stage we are saving the data to the "Risk Levels" sheet)

Set the Dim values
Set error handling
Set the short versions of the data form txtbox & cbobox values
Call the CheckGrowerID sub
Call the GetRowNumber sub
Call the CheckBlanks sub
Call the AdjustRiskLevel sub

Change ActiveSheet to "Whiteboard"
(Now trying to save the data to "Whiteboard" Sheet)

Call the SplitIt sub
' to determine the value to be used to define the test number

Call Bob's Function Get Column

then what???

Call the Clear Data sub

[Aussiebear]

or, to get the last digits, with or without an R
Sub SplitIt()
test = Replace("1000-21-01R", "-", " ")
MsgBox Split(Split(test)(UBound(Split(test))), "R")(0)
End Sub

Struggling to understand this portion of code. Starting with Replace

Replace means to "Replace part of a string, based on the number of characters you specify, with a different string."

test= Replace("1000-21'01R", "-", "")

So I'm guessing here that you are attempting to take out the dash/s from the string to leave us with "10002101R"

Then we move into the Split section of code.... :dunno

Help tells me that Split "Returns a zero based, one dimensional array containing a specified number of substrings." As in

" Split(Expression[,Delimiter[,Limit[,Compare]]])" Office 2007

Hmmmmm......

MsgBox Split(Split(test)(UBound(Split(test))), "R")(0)

Is Split(test) the expression?
Is (Unbound(Split(test) the delimiter?

If so then "R" becomes the limit and "0" tells me its a vbBinaryCompare.

Going back to help.... Doesn't help me as Unbound refers to Visio not Excel.

[mdmackillop]

Wicked of me I know!:devil2:
"Split" splits up text based on a delimiter typically Comma, Dash, or Space, (but really anything you choose to use).
It is normally used in the form
Arr = Split("1000-21-01R", "-")
Space is the default delimiter, so I don't have to specifically include it. By changing the dashes to spaces, I can simplify the later code which after using replace would become
Arr = Split("1000 21 01R")
Arrays have Lower and Upper values, based on the number of members. By default, this is a Zero base array, so the third member, Ubound(Arr) = 2, which is 01R.
Since we are using Split, just use it again to determine the numerical part if "R" was the delimiter now. The first member of the array will be the same whether or not R exists, so
Result = Split("01R","R")(0) and Result = Split("01","R")(0) give the same result
ie Result = 01
Here it is step by step.
Sub SplitIt()
Dim Arr, Cnt As Long, LastBit As String
'Form the array
Arr = Split("1000-21-01R", "-")
'Get the number of the last item
Cnt = UBound(Arr)
'Get the last item
LastBit = Arr(Cnt)
'Reuse Arr
'Use Split again, with R as the separarator. This will
'return the number part if R is there or not
Arr = Split(LastBit, "R")
'We want the first bit, which will be index 0 of the array
MsgBox Arr(0)
End Sub You'll find knowlege of Split very useful, and simpler than counting character positions in a lot of cases.

Turn "Bob Smith" to "Smith, Bob"
Rng.value = split(rng)(1) & ", " & split(rng)(0)

Get the start/end of a Range
St = Split(Rng.address,":")(0)

and so on.

[mdmackillop]

Have a look here (http://www.vbaexpress.com/forum/showthread.php?t=12168&highlight=split) or do a seach for Split in my posts, You should find a few examples. Maybe I'll do a short article!

[Aussiebear]

I just spent the last 24 hours mentally twisted into a knot.....

You are the :devil2: himself

[Aussiebear]

Bob's function code uses (ByVal Key As String) can I change "test" to "Key"?

[mdmackillop]

Hi Ted
A quick summary of Parameter. This is much the same for Subs and Functions
In XLD's code he uses Key as a String variable
Private Function GetColumn(ByVal Key As String)
Select Case Key
Case "01", "01R": GetColumn = "J" This means that you must pass a String as a Paramater, but the Name passed does not matter. You could use
Tmp = GetColumn(Key) or
Tmp = GetColumn(Test) or
Tmp = GetColumn("Trial") (if applicable), as long as Key, Test and Trial are
strings. This means you don't have to change a Sub/Function variable to match your particular code, making it more flexible.
If you have more than one parameter
Function GetColumns(Key1 as string, Key2 as String)
you can call this as
tmp =GetColumns(Test, Trial).
Key1 will become the value of Test and Key2 that of Trial.
If you use the same names, then you can pass them in any order as in
tmp = GetColumns(Key2, Key1) but although this may work, I wouldn't recommend it as potentially confusing.

A simple example
Sub TestIt()
Dim test As String
test = "01"
MsgBox GetColumn(test)
End Sub

Private Function GetColumn(ByVal Key As String)
Select Case Key
Case "01", "01R": GetColumn = "J"
End Select
End Function

[johnske]

Have a look here (http://www.vbaexpress.com/forum/showthread.php?t=12168&highlight=split) or do a seach for Split in my posts, You should find a few examples. Maybe I'll do a short article!http://www.j-walk.com/ss/excel/tips/tip93.htm also :)

[Aussiebear]

Don't panic folks..... its just starting to dawn on me.

[Aussiebear]

In Post#15 I tried to breakdown the code into smaller subs, was this reasonable?

[mdmackillop]

Maybe a bit excessive. Here's Post 8 recoded. Note that when you have a variable in your "head" sub eg Tgt, that you need to use in the called sub, you need to pass this information as a paramater. I've used "With Tgt" to avoid repeated typing of the variable

Private Sub cmdAdd_Click()
Dim Tgt As Range, col As Long
Dim Grower As String
Dim Vendor As String
Dim Result As String

On Error Resume Next

Grower = Me.txtGrowerID.Text
Vendor = Me.txtVendorTest.Text
Result = Me.cboResult.Text

' Check for a Grower ID
If Trim(Me.txtGrowerID.Text) = "" Then
Me.txtGrowerID.SetFocus
MsgBox "Please Enter a Grower ID"
Exit Sub
End If

'Get Row Number
Set Tgt = Cells(ActiveSheet.Columns(2).Find(What:=Grower, lookat:=xlWhole).Row, 1)

CheckForBlanks Tgt
AdjustRiskLevel Tgt

' Clear data from form after having written to sheet
Me.txtGrowerID.Value = ""
Me.txtVendorTest.Value = ""
Me.cboResult.Value = ""
Me.lblGrower.Caption = ""
Me.txtGrowerID.SetFocus
End Sub


Sub CheckForBlanks(Tgt As Range)
With Tgt
col = Application.WorksheetFunction.CountBlank(.Range("J1:L1"))
Select Case col
Case 0
.Range("K1:L2").Cut .Range("J1")
.Range("L1") = Vendor
.Range("L2") = Result
Case 1
.Range("L1") = Vendor
.Range("L2") = Result
Case 2
.Range("K1") = Vendor
.Range("K2") = Result
Case 3
.Range("J1") = Vendor
.Range("J2") = Result
End Select
End With
End Sub


Sub AdjustRiskLevel(Tgt As Range)
With Tgt
Select Case Me.cboResult
Case ">MRL"
.Range("M1") = 3
Case "<AL", ">AL"
If .Range("M1") = 0 Then .Range("M1") = 1
If .Range("M1") < 3 Then .Range("M1") = .Range("I1")
If .Range("M1") = 3 Then .Range("M1") = 3
Case "<LOR"
If .Range("M1") = 0 Then
'No Change
Else
Select Case col
Case Is < 2
If .Range("K2") = "<LOR" And .Range("L2") = "<LOR" Then
If .Range("M1") < 3 Then .Range("M1") = 0
If .Range("M1") = 3 Then .Range("M1") = Tgt.Range("I1")
End If
Case 2
If .Range("J2") = "<LOR" And .Range("K2") = "<LOR" Then
If .Range("M1") < 3 Then .Range("M1") = 0
If .Range("M1") = 3 Then .Range("M1") = .Range("I1")
End If
'Case 2
' No Change
'Case 3
' No Change
End Select
End If
End Select
End Sub

[Aussiebear]

This means that I can call the sub from the main section, it dashes off to the sub to do its thing, then rips back to the main code to continue the next line right?

For the sub SplitIt() can I pass the parameter "Vendor as String" since we declared it earlier? And can I then swap "test" for "Vendor" throughout the SplitIt code?

[Aussiebear]

I'd like to concentrate on Bob's line, now if I could

Worksheets("abc").Range (GetColumn(Me.txt.VendorTest.Text.Value) & RowNum) = "xyz"
Firstly, I'm assuming the "abc" needs to then be changed to the active worksheet, and that this then sets the whole worksheet as the range?

Secondly I'm assuming that the next portion uses the GetColumn function based on the current value of the Me.txt.Vendortest.Text. If it's able to determine the correct column, what tells it that it has the correct row?

"& RowNum" is doing what?

and finally the value "xyz" is this a cell position or what?

[Bob Phillips]

Worksheets("abc") should be change to some sheet object. But it doesn't set any range, it just identifies the worksheet.

The Rownum is assumed to have alreay been calculated and stored in RowNum. GetColumn returns the appropriate column letter.

xyz is just some value as an example.

[Aussiebear]

but Worksheets("abc").Range does though does it not?

[Bob Phillips]

Yes, that does.