PDA

View Full Version : Solved: A basic script going wrong



Mike_H
02-16-2009, 03:45 AM
Hi

Can anyone give me some guidance please? I have this small script that checks the user input and dependent on the result sets the cell to a specified colour and incements a variable. At the end of the list the system should check the variables and set cell B14 to the colour and text specified.

The first phase all works well, I have set breakpoints and the variables appear to increment. However, I cannot get cell B14 to set the relevant colour and text. Can anyone tell me why and how to rectify the problem?

Many thanks

Mike


Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, Me.Range("B2:B14")) Is Nothing Then Exit Sub
Dim CELL As Range, RNG As Range
Static GrStat As Integer
Static AmStat As Integer
Static ReStat As Integer


Set RNG = Target.Cells

For Each CELL In RNG
Select Case Trim(UCase(CELL.Value))
Case Is = "G"
CELL.Interior.ColorIndex = 4
GrStat = GrStat + 10
CELL.Text = "PASS"
Case Is = "A"
CELL.Interior.ColorIndex = 45
AmStat = AmStat + 50
Case Is = "R"
CELL.Interior.ColorIndex = 3
ReStat = ReStat + 1000
Case Else
CELL.Interior.ColorIndex = xlNone
End Select
Next CELL

If [B13] = True Then
If ReStat >= AmStat Then
ActiveSheet.Cells(14, 2).Interior.ColorIndex = 3
ActiveSheet.Cells(14, 2).Text.Bold = "FAIL"
Else
If AmStat >= GrStat Then
ActiveSheet.Cells(14, 2).Interior.ColorIndex = 45
ActiveSheet.Cells(14, 2).Text.Bold = "WARN"
Else
If GrStat = 0 Then
CELL.Interior.ColorIndex = xlNone
Else
ActiveSheet.Cells(14, 2).Interior.ColorIndex = 3
ActiveSheet.Cells(14, 2).Text.Bold = "PASS"
End If
End If
End If
End If


End Sub

Bob Phillips
02-16-2009, 04:00 AM
It works (sort of) for me if B13 is set to True, but it just goes into a loop.

Explain what you are trying to do, in English language, not code terms.

MaximS
02-16-2009, 04:26 AM
try now:


Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, Me.Range("B2:B14")) Is Nothing Then Exit Sub
Dim CELL As Range, RNG As Range
Static GrStat As Integer
Static AmStat As Integer
Static ReStat As Integer

Set RNG = Target.Cells
For Each CELL In RNG
Select Case Trim(UCase(CELL.Value))
Case Is = "G"
CELL.Interior.ColorIndex = 4
'GrStat = GrStat + 10
'CELL.Text = "PASS"
Case Is = "A"
CELL.Interior.ColorIndex = 45
'AmStat = AmStat + 50
Case Is = "R"
CELL.Interior.ColorIndex = 3
'ReStat = ReStat + 1000
Case Else
CELL.Interior.ColorIndex = xlNone
End Select
Next CELL
If [B13] <> "" Then
ReStat = WorksheetFunction.CountIf(Range("B2:B13"), "R")
AmStat = WorksheetFunction.CountIf(Range("B2:B13"), "A")
GrStat = WorksheetFunction.CountIf(Range("B2:B13"), "G")
If ReStat >= AmStat Then
ActiveSheet.Cells(14, 2).Interior.ColorIndex = 3
ActiveSheet.Cells(14, 2).Value = "FAIL"
Else
If AmStat >= GrStat Then
ActiveSheet.Cells(14, 2).Interior.ColorIndex = 45
ActiveSheet.Cells(14, 2).Value = "WARN"
Else
If GrStat = 0 Then
CELL.Interior.ColorIndex = xlNone
Else
ActiveSheet.Cells(14, 2).Interior.ColorIndex = 4
ActiveSheet.Cells(14, 2).Value = "PASS"
End If
End If
End If
Else
ActiveSheet.Cells(14, 2).Interior.ColorIndex = xlNone
ActiveSheet.Cells(14, 2).Value = ""
End If
End Sub

MaximS
02-16-2009, 04:41 AM
I would also change that:


If ReStat >= AmStat Then


with


If ReStat >= AmStat + GrStat Then

Mike_H
02-16-2009, 04:53 AM
Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, Me.Range("B2:B14")) Is Nothing Then Exit Sub
Dim CELL As Range, RNG As Range
Static GrStat As Integer
Static AmStat As Integer
Static ReStat As Integer

Set RNG = Target.Cells
For Each CELL In RNG
Select Case Trim(UCase(CELL.Value))
Case Is = "G"
CELL.Interior.ColorIndex = 4
'GrStat = GrStat + 10
'CELL.Text = "PASS"
Case Is = "A" CELL.Interior.ColorIndex = 45 'AmStat = AmStat + 50
Case Is = "R"
CELL.Interior.ColorIndex = 3
'ReStat = ReStat + 1000
Case Else
CELL.Interior.ColorIndex = xlNone
End Select
Next CELL
If [B13] <> "" Then
ReStat = WorksheetFunction.CountIf(Range("B2:B13"), "R")
AmStat = WorksheetFunction.CountIf(Range("B2:B13"), "A")
GrStat = WorksheetFunction.CountIf(Range("B2:B13"), "G")
If ReStat >= AmStat Then
ActiveSheet.Cells(14, 2).Interior.ColorIndex = 3
ActiveSheet.Cells(14, 2).Value = "FAIL"
Else
If AmStat >= GrStat Then
ActiveSheet.Cells(14, 2).Interior.ColorIndex = 45
ActiveSheet.Cells(14, 2).Value = "WARN"
Else
If GrStat = 0 Then
CELL.Interior.ColorIndex = xlNone
Else
ActiveSheet.Cells(14, 2).Interior.ColorIndex = 4
ActiveSheet.Cells(14, 2).Value = "PASS"
End If
End If
End If
Else
ActiveSheet.Cells(14, 2).Interior.ColorIndex = xlNone
ActiveSheet.Cells(14, 2).Value = ""
End If
End Sub

mdmackillop
02-16-2009, 05:04 AM
Hi Mike,
When you post code, select it and click the green VBA button to get it formatted automatically
Regards
MD

Mike_H
02-16-2009, 05:05 AM
Sorry for duplication above, having troubles replying to posts. Thanks to bioth of you. MaximS post sorts my immediate problem. I have a follow on question. Would it be possible to do this under a form?

We have a compliance report that has to be created for each of our systems. The report has 12 Criteria that can be either

Green Passed and all requirements met
Amber Passed but not all requirements are 100% met
Red One or more requirements are not met at all

I was thinking I could create a form and each requirement would be presented with the explanation of each of the citeria. The operator could select from traffic light options (radio Buttons) The results would be copied to the underlying spread sheet so reports can be generated. Is this feasible or is it big boy stuff and I should stay in the nursery for awhile?

Thanks again for your input

Mike

MaximS
02-16-2009, 08:57 AM
hey,

check attachment to see UserForm you can use for above task.

i hope you'll like it, but it still might need some adjustments.

Mike_H
02-16-2009, 12:44 PM
MaximS

Many thanks for your time and trouble, will have a play. Sorry for delay in writing back. Just spent two hours fixing a computer when the issue was a user with caps lock on despite asking numerous times for them to check :banghead:

Mike_H
02-17-2009, 01:37 AM
MaximS

Liked the idea of the form. I think my ideas, well my bosses:014: is a bit more "Managerial" I think I have uploaded the current file I am working on for you to see thier requirements. I am currently badgering them to pay for me to do the online training course fingers crossed. Hopefully I have managed to attach an image of thier view. Perhaps you can tell me if it is at all possible.

Mike

MaximS
02-17-2009, 01:40 AM
Of course is possible and will post it as soon is ready.

Mike_H
02-17-2009, 02:21 AM
Wow brill. If your ever near Norfolk I owe you a pint or two - :beerchug:

Mike

MaximS
02-17-2009, 06:58 AM
hi Mike,

see attachment for solution (placed in Sheet3)

Enjoy.

Mike_H
02-17-2009, 09:17 AM
Hi Maxim, sent you a private message, I think

Mike

MaximS
02-17-2009, 10:39 AM
Havn't got it.

Mike_H
02-17-2009, 11:56 AM
Tried an e-mail this time - Mike

MaximS
02-20-2009, 06:49 AM
try this version, see attachment for details.

Mike_H
02-20-2009, 07:26 AM
Max

Absolutely Brilliant, just as I imagined it. I even understand the code, well some anyway. Just two questions. How do the useres enter the application name? My form had a field under the label Application name, but I tried to be clever and set the colours to the colours of the form so it was hidden from your view. This would be used to save the document away.

Secondly, the math; Where are the variables held/ as if there is a single RED in the list it should be an automatic fail because that has a score of 1000 and even if all the others are Ambers which has a score of 50 it will not outscore a red?

Thanks again

Mike

MaximS
02-20-2009, 09:38 AM
we will sort this out today

Mike_H
02-20-2009, 01:15 PM
Terrific; It looks good, my boss is so impressed with what has been produced he has blagged some money from one of the project teams to pay for the sites on line training course. Hopefully I will learn enough to do all the things he's got planned lol. So thank you

MaximS
02-20-2009, 01:16 PM
ok now should meet the requirements :)

Mike_H
02-26-2009, 02:57 AM
Maxims did you get an opportunity to look at my last problem? Not sure what the current status is
Regards,

Mike

MaximS
02-26-2009, 04:08 PM
yes that should solve your last problem, if not we will correct it on forum

Mike_H
03-01-2009, 03:48 PM
A Big thank you MaximS for your kindness perseverence and most of all brilliant resolution. I'll try not to ask to many more dumb questions; no promises though

Mike