PDA

View Full Version : Solved: Risk level assessment



Aussiebear
08-30-2006, 12:30 AM
There is an initial problem with the Example in so far as the Show/Hide button does not work. Its objective was simply to show or hide the column H, if anyone wants to correct the code then I can get on to the main thrust of the post.

I am looking for a procedure by which I can determine the Risk Level of a Vendor who supplies grain. The initial risk level is determined by the company, and from then on it is determined by the results obtained from the grain being delivered.
Col A is system generated, Col B is the trading name of the Vendor Dec, Col C is the initial Starting Risk Level ( refer to Rules Sheet), Cols D E & F are the Vendor's last three results if possible, and Col G is the new Risk Level derived from the results.

Since a Vendor needs 2 consecutive "<LOR" results to improve his/her position, or if they already have a 0 risk level, a "<LOR" to maintain their rating, I am looking for something which can input the info from the Vendor Risk Level form to the last available cell in the row of the Vendor.

Example: Assume the Vendor risk Level form has the following information
Grower ID 4, Vendor Dec ID 4653-02-01, and result <LOR. On clicking Save & New, Excel finds the correct row,in this case Row 4, as the Grower ID is 4 ( checks this as a validation method), and then enters the Vendor Dec ID in the next avaialble cell in the range D4:F4, which in this case is F4. Then put the Result value in the Cell below F5.

Note: If Cells F4-F5 had already been filled, I needed cells D4-D5 to deleted and cells E4-E5 & F4-F5 to be moved one cell to the left to make room for the new data. The code then reads the last two results for that Vendor and makes an adjustment if necessary to the New Risk level rating.

The description in Column H will not normally be there. It is there only to help explain the current risk levels and is based on the matrix on the Rules Sheet.

Have I confused even the best of you yet?

Ted

Bob Phillips
08-30-2006, 01:30 AM
First bit.

Change the button name to ToggleButton and use this code



Sub Show_Hide()
With ActiveSheet.Buttons("ToggleButton")
If .Caption = "Hide" Then
Columns("H:H").Hidden = True
.Caption = "Show"
Else
Columns("H:H").Hidden = False
.Caption = "Hide"
End If
End With
End Sub


Second bit. Totally lost me.

Aussiebear
08-30-2006, 03:58 AM
OKay its time to fire up the imagination..... well not really.

I will be entering the results info via a form. The form will contain the following information, A grower ID, a Vendor Dec ID and a result.

I need the form to find the correct grower id by matching its Grower ID with that entered in the form. Then comes the important bit. The data that the form carries the vendor dec ID and its result will be saved into the range Col D to F of the grower ID and place the data in the next empty cells that it can find. Should it find that all the cells in that range are already full, it will simply delete the data in the cells on the left hand of the range and then move all the remaining data one cell to the left and dump its own data in the right hand side of the range. This is so that only a mazimum 3 columns of data is available at any one time. The objective here is to have the code read off the results of the last three results of a grower and amend the risk level as necessary.

Aussiebear
08-31-2006, 05:37 AM
Lets break the procedure down. Could a Vlookup function be used to find the correct row or do we need to look at a validation?

Aussiebear
09-14-2006, 03:24 AM
ON a different track this time.. well sort of. How does one find the correct row from a value in a form? If I were to type in 4 in the form, could it find the same value in Column A and set that row as the target row?

Ted

Aussiebear
09-15-2006, 04:55 PM
Out of pure desperation here's what I hope might be close.



Private Sub cmdAdd()

' using the value in txtGrowerID find the row with the matching Value in
' Column A and make this the target row

'For the purpose of this example lets assume the value is 3, so Row 6
'becomes the target row.
'????

' Check for a GrowerID
If Trim(Me.txtGrowerID.Value) = "" Then
Me.txtGrowerID.SetFocus
MsgBox "Please enter a Grower ID"
Exit Sub
End if

'Determine if Column D of this row is blank
If Range ("D6") = "" Then
ActiveCell.Value = txtGrowerID.Text.value
ActiveCell.Offset(0,1).Activate
ActiveCell.Value = txtResult.Txt.Value

' IF Cell D6 is not blank then offset to Cell E6
ElseIF ActiveCell.Value <> "" Then
Activecell.Offset(1,0).Activate
ActiveCell.Value = txtGrowerID.Text.Value
ActiveCell.Offset(0,1).Activate
ActiveCell.Value = txtresult.text.value

' If Cell E6 is not blank then offset to cell F6
ElseIF ActiveCell.Value <> "" Then
ActiveCell.Offset(1,0). Activate
ActiveCell.Value = txtGrowerID.Text.Value
ActiveCell.OffSet(0,1). Activate
ActiveCell.Value = txtResult.text.Value

'If Cell F6 is not blank, then delete data in Range ("D6:D7"), select range (E6:F7") _
' and move to range (D6:E8") and then write data to Range ("F6:F7")
ElseIF ActiveCell.Value <> "" Then
Range("D6:D7").Select
ActiveChart.Parent.Delete
Range("E6:F7").Select
Selection.Cut Destination:= Range("D6:D7")
Range ("F6").Select
If ActiveCell.Value = "" Then
ActiveCell.Value = txtGrowerID.Text.Value
ActiveCell.OffSet(0,1).Activate
ActiveCell.Value = txtresult.text.Value
End IF

'Clear Data from form for new information
Me.txtgrowerID.Value = ""
Me.txtVendorTest.Value = ""
Me.txtResult.Value = ""
Me.txtGrowerID.SetFocus

End Sub



Most sections have been plagurised ( sliced, diced and slapped silly before entering here) from various code samples I've found in cyber space. So the first question here is... Am I just howling at the moon or am I heading in the right direction?

mdmackillop
09-16-2006, 04:38 PM
Hi Ted,
A good try. You need to try and avoid selecting a cell and using the activecell method. I've set Tgt as the found cell in column 1 and used the Range method to read/change the corresponding values.
I inserted a combobox for the Results to simplify entry, and renamed the textboxes to suit their purpose. I've not used your buttons or detailed error handling for the form, as these can easily be adjusted to suit.
Regards
MD

Private Sub cmdAdd()
Dim Tgt As Range, Col As Long
Dim Grower As Long
Dim Vendor As String
Dim Result As String
On Error GoTo ErrH
Grower = Me.txtGrowerID.Value
Vendor = txtVendorDecID.Text
Result = comboResult.Text
' Check for a GrowerID
If Trim(Me.txtGrowerID.Value) = "" Then
Me.txtGrowerID.SetFocus
MsgBox "Please enter a Grower ID"
Exit Sub
End If
'Get row number
Set Tgt = Cells(ActiveSheet.Columns(1).Find(what:=Grower, lookat:=xlWhole).Row, 1)
'Check for blanks
Col = Application.WorksheetFunction.CountBlank(Tgt.Range("D1:F1"))
Select Case Col
Case 0
Tgt.Range("E1:F2").Cut Tgt.Range("D1")
Tgt.Range("F1") = Vendor
Tgt.Range("F2") = Result
Case 1
Tgt.Range("F1") = Vendor
Tgt.Range("F2") = Result
Case 2
Tgt.Range("E1") = Vendor
Tgt.Range("E2") = Result
Case 3
Tgt.Range("D1") = Vendor
Tgt.Range("D2") = Result
End Select

'Adjust value for result
Select Case Me.comboResult
Case ">MRL"
Tgt.Range("G1") = 3

Case "<AL", ">AL"
If Tgt.Range("G1") = 0 Then
Tgt.Range("G1") = 1
Else
'No change
End If

Case "<LOR"
If Tgt.Range("G1") = 0 Then
'No Change
Else
Select Case Col
Case 0
If Tgt.Range("E2") = "<LOR" And Tgt.Range("F2") = "<LOR" Then
If Tgt.Range("G1") > 0 Then
Tgt.Range("G1") = Tgt.Range("G1") - 1
End If
End If
Case 1
If Tgt.Range("D2") = "<LOR" And Tgt.Range("E2") = "<LOR" Then
If Tgt.Range("G1") > 0 Then
Tgt.Range("G1") = Tgt.Range("G1") - 1
End If
End If
Case 2
'No Change
Case 3
'No Change
End Select
End If
End Select
'Clear Data from form for new information
Me.txtGrowerID.Value = ""
Me.txtVendorDecID.Value = ""
Me.comboResult.Value = ""
Me.txtGrowerID.SetFocus
ErrH:
'Add stuff here
End Sub


BTW, I spotted the "deliberate error" in your Risk Levels table. Just trying to keep us on our toes!:devil2:

Aussiebear
09-16-2006, 05:15 PM
Quilty as charged, your Honour!.... LOL.

BTW, just so I know what you know, just what am I charged with??

mdmackillop
09-16-2006, 05:21 PM
Hi Ted,
Check your Level 2 & 3 for LOR result.
BTW, I've amended my post for an error in the Case AL code
Regards
MD

Aussiebear
09-16-2006, 05:40 PM
MD. Not sure what you are pointing out to me here but the rules by which I will be required to use for the assessing of the risk level have been defined by the company

Risk Levels for Single Venders are 0, 1 and 3, (with 1 being the initial risk level assigned). Whereas Risk Levels for Multivendor's are 0, 2 & 3 ( with 2 being the initial risk level assigned).

Single Vendors require 2 consecutive "<LOR" results to move to 0, but any "<AL" or ">AL" result will move you to 1, ( if you were a 0) or retains your status as a 1, if already a 1. A ">MRL" result moves you to a 3, with stringent conditions applied before trade can resume.

Multivendors require 2 consecutive "<LOR" results to move to 0, but any "AL" or ">AL" result will move you to a 2, ( if you were a 0) or retains your status as a 2, if already a 2. A ">MRL" result moves you to a 3, with stringent conditions applied before trade can resume. Note: Multivendors are the grain handlers who recieve, store, and trade multi grain types as against Single vendors who physically grow the grain being delivered.

Is this what you are querying?
Ted

mdmackillop
09-16-2006, 05:47 PM
Table

Aussiebear
09-16-2006, 09:02 PM
Ok. If Multivendor became a 3 because of an">MRL" result, they need to provide two samples to a NATA laboratory ( at their cost), and the results both need to be "<LOR" before trade can continue. Once this is done they are then re-assigned to the initial risk level as a starting point. As they deliver grain and we recieve additional results, providing they are "<LOR" then they will move to a 0.

The objective in showing the last three results is so that we can see if a vendor's history ( Single or Multivendor) might have included a risk level 3 rating. Hence the reason why I need the values in Columns D E & F to be shown

Normally, we only need the last two known results to reassign, ( if required) the risk level. Some of our clients have more than 50 test results because of the length of trade history they have built with us. Their risk level floats about according to the last two recorded results ( as a minimum). When I came to the company we used to record this manually in a book, but it was entirely messy, as some clients had filled their allocated space and had been allotted a second or third space ( sometimes in another book). Four or five people had written items into the books, with different styles etc, and it was extremely time consuming to work it all out.

Its because of this then, that the code from the line " 'Adjust the value" will need to be re evaluated.

Aussiebear
09-16-2006, 09:06 PM
Aha. I can see the issue now. The comments that I had atached to cells D12 & D13, I can only assume they did not come through in the uplink to you.

Sorry if that's the case

mdmackillop
09-17-2006, 05:20 AM
Hi Ted,
the following change uses the Initial Values rather than the Current Values as the basis for the revised current value (if that makes sense) as per the table below

Case "<LOR"
If Tgt.Range("G1") = 0 Then
'No Change
Else
Select Case Col
Case 0
If Tgt.Range("E2") = "<LOR" And Tgt.Range("F2") = "<LOR" Then
If Tgt.Range("G1") < 3 Then Tgt.Range("G1") = 0
If Tgt.Range("G1") = 3 Then Tgt.Range("G1") = Tgt.Range("C1")
End If
Case 1
If Tgt.Range("D2") = "<LOR" And Tgt.Range("E2") = "<LOR" Then
If Tgt.Range("G1") < 3 Then Tgt.Range("G1") = 0
If Tgt.Range("G1") = 3 Then Tgt.Range("G1") = Tgt.Range("C1")
End If
Case 2
'No Change
Case 3
'No Change
End Select
End If

Aussiebear
09-18-2006, 03:57 AM
MD, Went to work and foled around with your concept, except the cbobox which i changed back to a txtbox. Found the following issues, and I was wondering if you could see why I've stuffed it up.

Grower ID 1 Should have changed to a Zero
Grower ID 2 Should have changed to a Zero
Grower ID 3 Correct
Grower ID 4 Should have changed to a 1
Grower ID 5 Correct
Grower ID 6 Correct
Grower ID 7 Should have changed to a Zero.

Have I typed in the code incorrectly?

Ted

mdmackillop
09-18-2006, 05:07 AM
Hi Ted,
This is what testing is for!
try

Case "<LOR"
If Tgt.Range("G1") = 0 Then
' No Change
Else
Select Case Col
Case Is < 2
If Tgt.Range("E2") = "<LOR" And Tgt.Range("F2") = "<LOR" Then
If Tgt.Range("G1") < 3 Then Tgt.Range("G1") = 0
If Tgt.Range("G1") = 3 Then Tgt.Range("G1") = Tgt.Range("C1")
End If
Case 2
If Tgt.Range("D2") = "<LOR" And Tgt.Range("E2") = "<LOR" Then
If Tgt.Range("G1") < 3 Then Tgt.Range("G1") = 0
If Tgt.Range("G1") = 3 Then Tgt.Range("G1") = Tgt.Range("C1")
End If
Case 3
' No Change
End Select
End If

Aussiebear
09-18-2006, 06:14 AM
Big improvement except if you have two "LOR" results followed by a poor one "<Al" or ">Al" it should reassign the level from 0 to 1.

So could I write the following



If Tgt.Range("D2") = "<LOR" And Tgt.Range("E2") = "<LOR" And Tgt.Range("F2") = "<AL" Or ">Al" Then
If Tgt.Range("G1") < 3 Then Tgt.Range("G1") =1
If Tgt.Range("G1") = 3 Then Tgt.Range("G1") = 3
End IF



Trouble is.. What is the Case?

mdmackillop
09-18-2006, 06:27 AM
That should happen already with this statement. Try stepping through the code for this result
Case "<AL", ">AL"
If Tgt.Range("G1") = 0 Then
Tgt.Range("G1") = 1
Else
'No change
End If

mdmackillop
09-18-2006, 06:33 AM
On inspection, it looks like an Upper Case problem since you remove the combo. Try adding an Option Compare Text line.

Aussiebear
09-18-2006, 06:48 AM
That seems to have fixed it. I shall try this at work tomorrow ( well a little over 5 hours time actually). I will be linking the Current Risk level ("G1") to the Whiteboard Sheet so that when I type in a Vendor Name I can assign the latest risk level that the vendor has earned.

One question here though, can some form of validation be put in place so one cannot enter the same Vendor Dec Test number more than once? I sometimes send a sample away for a more detailed chemical examination but include an R on the end of the number to show its a retest of an existing tested sample.

mdmackillop
09-18-2006, 08:21 AM
Private Sub txtVendorTest_AfterUpdate()
Dim c As Range
On Error Resume Next
Set c = Columns("D:F").Find(txtVendorTest.Text)
If Not c Is Nothing Then
MsgBox "Test No. exists in cell " & c.Address(0, 0)
End If
End Sub

Aussiebear
09-19-2006, 01:56 AM
MD, its a winner. Mind you a simple typo at work had me scratching my head for a while. Thank you for you generous help on this matter.