Loop to check if a cell value meets a condtion
0
Forgive the novice loop question that has been posted so many times on SO, but I can't seem to figure out what should be simple logic. Below outlines the steps of what I am trying to accomplish:
- Loop through all cells in range AllScores
- Look to see if
Left(wsRR.Range("H32"),1)is "P" or "G" - If any of the cells in range AllScores have a value between 1 and 4 and #2 above is true, then the captions of Label143 and RR_Score = "Acceptable 06"
If all of the values of the cells in range AllScores >= 5 then the captions of Label143 and RR_Score = the value of range wsRR.("H32") or if all of the values in each cell in Range AllScores is >= 5 and #2 above is true or false then the captions for Labels RR_Score and Label143 = wsRR.("H32").
Sub ScoringUpdateAmounts()
Dim aScores As Range
Dim a As Integer
Dim i As Long
Set wb = Application.ThisWorkbook
Set wsRR = wb.Sheets("RiskRating")
Set wspGen = wb.Sheets("pGeneralInfo")
Set aScores = wsRR.Range("AllScores")
For i = 1 To 4
For Each cell In aScores
If cell.Value = i Then a = 0
Next cell
Next i
For i = 5 To 8
For Each cell In aScores
If cell.Value = i Then a = 1
Next cell
Next i
Select Case Left(wsRR.Range("H32"), 4)
Case Is = "GOOD"
If a = 0 Then
RiskCalc.RR_Score.Caption = UCase("acceptable 06")
RisKRating.Label143.Caption = RiskCalc.RR_Score.Caption
wspGen.Range("genRR") = UCase("acceptable 06")
wspGen.Range("genJHARiskRating") = UCase("acceptable 06")
End If
If a = 1 Then
RiskCalc.RR_Score.Caption = UCase(wsRR.Range("H32"))
RisKRating.Label143.Caption = UCase(wsRR.Range("H32"))
wspGen.Range("genRR") = UCase(wsRR.Range("H32"))
wspGen.Range("genJHARiskRating") = UCase(wsRR.Range("H32"))
End If
End Select
Select Case Left(wsRR.Range("H32"), 5)
Case Is = "PRIME"
If a = 0 Then
RiskCalc.RR_Score.Caption = UCase("acceptable 06")
RisKRating.Label143.Caption = RiskCalc.RR_Score.Caption
wspGen.Range("genRR") = UCase("acceptable 06")
wspGen.Range("genJHARiskRating") = UCase("acceptable 06")
End If
If a = 1 Then
RiskCalc.RR_Score.Caption = UCase(wsRR.Range("H32"))
RisKRating.Label143.Caption = UCase(wsRR.Range("H32"))
wspGen.Range("genRR") = UCase(wsRR.Range("H32"))
wspGen.Range("genJHARiskRating") = UCase(wsRR.Range("H32"))
End If
End Select
End Sub
vba excel-2013
asked Nov 20 at 22:22
Zack E
10310
|
show 11 more comments
0
Forgive the novice loop question that has been posted so many times on SO, but I can't seem to figure out what should be simple logic. Below outlines the steps of what I am trying to accomplish:
- Loop through all cells in range AllScores
- Look to see if
Left(wsRR.Range("H32"),1)is "P" or "G" - If any of the cells in range AllScores have a value between 1 and 4 and #2 above is true, then the captions of Label143 and RR_Score = "Acceptable 06"
If all of the values of the cells in range AllScores >= 5 then the captions of Label143 and RR_Score = the value of range wsRR.("H32") or if all of the values in each cell in Range AllScores is >= 5 and #2 above is true or false then the captions for Labels RR_Score and Label143 = wsRR.("H32").
Sub ScoringUpdateAmounts()
Dim aScores As Range
Dim a As Integer
Dim i As Long
Set wb = Application.ThisWorkbook
Set wsRR = wb.Sheets("RiskRating")
Set wspGen = wb.Sheets("pGeneralInfo")
Set aScores = wsRR.Range("AllScores")
For i = 1 To 4
For Each cell In aScores
If cell.Value = i Then a = 0
Next cell
Next i
For i = 5 To 8
For Each cell In aScores
If cell.Value = i Then a = 1
Next cell
Next i
Select Case Left(wsRR.Range("H32"), 4)
Case Is = "GOOD"
If a = 0 Then
RiskCalc.RR_Score.Caption = UCase("acceptable 06")
RisKRating.Label143.Caption = RiskCalc.RR_Score.Caption
wspGen.Range("genRR") = UCase("acceptable 06")
wspGen.Range("genJHARiskRating") = UCase("acceptable 06")
End If
If a = 1 Then
RiskCalc.RR_Score.Caption = UCase(wsRR.Range("H32"))
RisKRating.Label143.Caption = UCase(wsRR.Range("H32"))
wspGen.Range("genRR") = UCase(wsRR.Range("H32"))
wspGen.Range("genJHARiskRating") = UCase(wsRR.Range("H32"))
End If
End Select
Select Case Left(wsRR.Range("H32"), 5)
Case Is = "PRIME"
If a = 0 Then
RiskCalc.RR_Score.Caption = UCase("acceptable 06")
RisKRating.Label143.Caption = RiskCalc.RR_Score.Caption
wspGen.Range("genRR") = UCase("acceptable 06")
wspGen.Range("genJHARiskRating") = UCase("acceptable 06")
End If
If a = 1 Then
RiskCalc.RR_Score.Caption = UCase(wsRR.Range("H32"))
RisKRating.Label143.Caption = UCase(wsRR.Range("H32"))
wspGen.Range("genRR") = UCase(wsRR.Range("H32"))
wspGen.Range("genJHARiskRating") = UCase(wsRR.Range("H32"))
End If
End Select
End Sub
vba excel-2013
asked Nov 20 at 22:22
Zack E
10310
What is the purpose of theFor i = 1 To 4andFor i = 5 To 8loops? You'll only end up a value ofafor the last cell inaScores.
– Comintern
Nov 20 at 22:27
What range corresponds toaScores?
– Tim Williams
Nov 20 at 22:29
If any of the cells in rangeaScoresare <= 4 then I wanta=0so i can define the text boxes and some other ranges with the appropriate value. I hope that makes sense.
– Zack E
Nov 20 at 22:29
@TimWilliamsDim wb As Workbook Dim wsRR As Worksheet Set aScores = wsRR.Range("AllScores")
– Zack E
Nov 20 at 22:30
Yes that's obvious from your code, but what range isAllScores?
– Tim Williams
Nov 20 at 22:31
|
show 11 more comments
0
0
0
Forgive the novice loop question that has been posted so many times on SO, but I can't seem to figure out what should be simple logic. Below outlines the steps of what I am trying to accomplish:
- Loop through all cells in range AllScores
- Look to see if
Left(wsRR.Range("H32"),1)is "P" or "G" - If any of the cells in range AllScores have a value between 1 and 4 and #2 above is true, then the captions of Label143 and RR_Score = "Acceptable 06"
If all of the values of the cells in range AllScores >= 5 then the captions of Label143 and RR_Score = the value of range wsRR.("H32") or if all of the values in each cell in Range AllScores is >= 5 and #2 above is true or false then the captions for Labels RR_Score and Label143 = wsRR.("H32").
Sub ScoringUpdateAmounts()
Dim aScores As Range
Dim a As Integer
Dim i As Long
Set wb = Application.ThisWorkbook
Set wsRR = wb.Sheets("RiskRating")
Set wspGen = wb.Sheets("pGeneralInfo")
Set aScores = wsRR.Range("AllScores")
For i = 1 To 4
For Each cell In aScores
If cell.Value = i Then a = 0
Next cell
Next i
For i = 5 To 8
For Each cell In aScores
If cell.Value = i Then a = 1
Next cell
Next i
Select Case Left(wsRR.Range("H32"), 4)
Case Is = "GOOD"
If a = 0 Then
RiskCalc.RR_Score.Caption = UCase("acceptable 06")
RisKRating.Label143.Caption = RiskCalc.RR_Score.Caption
wspGen.Range("genRR") = UCase("acceptable 06")
wspGen.Range("genJHARiskRating") = UCase("acceptable 06")
End If
If a = 1 Then
RiskCalc.RR_Score.Caption = UCase(wsRR.Range("H32"))
RisKRating.Label143.Caption = UCase(wsRR.Range("H32"))
wspGen.Range("genRR") = UCase(wsRR.Range("H32"))
wspGen.Range("genJHARiskRating") = UCase(wsRR.Range("H32"))
End If
End Select
Select Case Left(wsRR.Range("H32"), 5)
Case Is = "PRIME"
If a = 0 Then
RiskCalc.RR_Score.Caption = UCase("acceptable 06")
RisKRating.Label143.Caption = RiskCalc.RR_Score.Caption
wspGen.Range("genRR") = UCase("acceptable 06")
wspGen.Range("genJHARiskRating") = UCase("acceptable 06")
End If
If a = 1 Then
RiskCalc.RR_Score.Caption = UCase(wsRR.Range("H32"))
RisKRating.Label143.Caption = UCase(wsRR.Range("H32"))
wspGen.Range("genRR") = UCase(wsRR.Range("H32"))
wspGen.Range("genJHARiskRating") = UCase(wsRR.Range("H32"))
End If
End Select
End Sub
vba excel-2013
asked Nov 20 at 22:22
Zack E
10310
Forgive the novice loop question that has been posted so many times on SO, but I can't seem to figure out what should be simple logic. Below outlines the steps of what I am trying to accomplish:
- Loop through all cells in range AllScores
- Look to see if
Left(wsRR.Range("H32"),1)is "P" or "G" - If any of the cells in range AllScores have a value between 1 and 4 and #2 above is true, then the captions of Label143 and RR_Score = "Acceptable 06"
If all of the values of the cells in range AllScores >= 5 then the captions of Label143 and RR_Score = the value of range wsRR.("H32") or if all of the values in each cell in Range AllScores is >= 5 and #2 above is true or false then the captions for Labels RR_Score and Label143 = wsRR.("H32").
Sub ScoringUpdateAmounts()
Dim aScores As Range
Dim a As Integer
Dim i As Long
Set wb = Application.ThisWorkbook
Set wsRR = wb.Sheets("RiskRating")
Set wspGen = wb.Sheets("pGeneralInfo")
Set aScores = wsRR.Range("AllScores")
For i = 1 To 4
For Each cell In aScores
If cell.Value = i Then a = 0
Next cell
Next i
For i = 5 To 8
For Each cell In aScores
If cell.Value = i Then a = 1
Next cell
Next i
Select Case Left(wsRR.Range("H32"), 4)
Case Is = "GOOD"
If a = 0 Then
RiskCalc.RR_Score.Caption = UCase("acceptable 06")
RisKRating.Label143.Caption = RiskCalc.RR_Score.Caption
wspGen.Range("genRR") = UCase("acceptable 06")
wspGen.Range("genJHARiskRating") = UCase("acceptable 06")
End If
If a = 1 Then
RiskCalc.RR_Score.Caption = UCase(wsRR.Range("H32"))
RisKRating.Label143.Caption = UCase(wsRR.Range("H32"))
wspGen.Range("genRR") = UCase(wsRR.Range("H32"))
wspGen.Range("genJHARiskRating") = UCase(wsRR.Range("H32"))
End If
End Select
Select Case Left(wsRR.Range("H32"), 5)
Case Is = "PRIME"
If a = 0 Then
RiskCalc.RR_Score.Caption = UCase("acceptable 06")
RisKRating.Label143.Caption = RiskCalc.RR_Score.Caption
wspGen.Range("genRR") = UCase("acceptable 06")
wspGen.Range("genJHARiskRating") = UCase("acceptable 06")
End If
If a = 1 Then
RiskCalc.RR_Score.Caption = UCase(wsRR.Range("H32"))
RisKRating.Label143.Caption = UCase(wsRR.Range("H32"))
wspGen.Range("genRR") = UCase(wsRR.Range("H32"))
wspGen.Range("genJHARiskRating") = UCase(wsRR.Range("H32"))
End If
End Select
End Sub
vba excel-2013
vba excel-2013
asked Nov 20 at 22:22
Zack E
10310
asked Nov 20 at 22:22
Zack E
10310
edited Nov 21 at 3:17
asked Nov 20 at 22:22
Zack E
10310
asked Nov 20 at 22:22
Zack E
10310
asked Nov 20 at 22:22
Zack E
10310
10310
What is the purpose of theFor i = 1 To 4andFor i = 5 To 8loops? You'll only end up a value ofafor the last cell inaScores.
– Comintern
Nov 20 at 22:27
What range corresponds toaScores?
– Tim Williams
Nov 20 at 22:29
If any of the cells in rangeaScoresare <= 4 then I wanta=0so i can define the text boxes and some other ranges with the appropriate value. I hope that makes sense.
– Zack E
Nov 20 at 22:29
@TimWilliamsDim wb As Workbook Dim wsRR As Worksheet Set aScores = wsRR.Range("AllScores")
– Zack E
Nov 20 at 22:30
Yes that's obvious from your code, but what range isAllScores?
– Tim Williams
Nov 20 at 22:31
|
show 11 more comments
What is the purpose of theFor i = 1 To 4andFor i = 5 To 8loops? You'll only end up a value ofafor the last cell inaScores.
– Comintern
Nov 20 at 22:27
What range corresponds toaScores?
– Tim Williams
Nov 20 at 22:29
If any of the cells in rangeaScoresare <= 4 then I wanta=0so i can define the text boxes and some other ranges with the appropriate value. I hope that makes sense.
– Zack E
Nov 20 at 22:29
@TimWilliamsDim wb As Workbook Dim wsRR As Worksheet Set aScores = wsRR.Range("AllScores")
– Zack E
Nov 20 at 22:30
Yes that's obvious from your code, but what range isAllScores?
– Tim Williams
Nov 20 at 22:31
What is the purpose of the
For i = 1 To 4 and For i = 5 To 8 loops? You'll only end up a value of a for the last cell in aScores.– Comintern
Nov 20 at 22:27
What is the purpose of the
For i = 1 To 4 and For i = 5 To 8 loops? You'll only end up a value of a for the last cell in aScores.– Comintern
Nov 20 at 22:27
What range corresponds to
aScores ?– Tim Williams
Nov 20 at 22:29
What range corresponds to
aScores ?– Tim Williams
Nov 20 at 22:29
If any of the cells in range
aScores are <= 4 then I want a=0 so i can define the text boxes and some other ranges with the appropriate value. I hope that makes sense.– Zack E
Nov 20 at 22:29
If any of the cells in range
aScores are <= 4 then I want a=0 so i can define the text boxes and some other ranges with the appropriate value. I hope that makes sense.– Zack E
Nov 20 at 22:29
@TimWilliams
Dim wb As Workbook Dim wsRR As Worksheet Set aScores = wsRR.Range("AllScores")– Zack E
Nov 20 at 22:30
@TimWilliams
Dim wb As Workbook Dim wsRR As Worksheet Set aScores = wsRR.Range("AllScores")– Zack E
Nov 20 at 22:30
Yes that's obvious from your code, but what range is
AllScores ?– Tim Williams
Nov 20 at 22:31
Yes that's obvious from your code, but what range is
AllScores ?– Tim Williams
Nov 20 at 22:31
|
show 11 more comments
3 Answers
3
active
oldest
votes
1
I doubt this will fix your problem, but this is too long for a comment.
I re-structured your code as it currently stands and removed redundant/unneeded lines.
There is something funky going on in your 1-8 loop. You may need to take a step back and re-think out the logic here.
If you just want to know if the range has a value below some threshold you can use Min function to do so and ditch the loop like so
If Application.WorksheetFunction.Min(aScores) <= 4 Then
a = 0
Else
a = 1
End If
Either way, easier to read/follow code tends to make debugging logic-errors much, much easier
Option Explicit
Sub ScoringUpdateAmounts()
Dim wsRR As Worksheet: Set wsRR = ThisWorkbook.Sheets("RiskRating")
Dim wspGen As Worksheet: Set wspGen = ThisWorkbook.Sheets("pGeneralInfo")
Dim aScores As Range, a As Integer, MyCell As Range
Set aScores = wsRR.Range("AllScores")
For Each MyCell In aScores
Select Case MyCell
Case 1, 2, 3, 5
a = 0
Case 5, 6, 7, 8
a = 1
End Select
Next MyCell
If Left(wsRR.Range("H32"), 4) = "GOOD" Then
If a = 0 Then
RiskCalc.RR_Score.Caption = "ACCEPTABLE 06"
RisKRating.Label143.Caption = RiskCalc.RR_Score.Caption
wspGen.Range("genRR") = "ACCEPTABLE 06"
wspGen.Range("genJHARiskRating") = "ACCEPTABLE 06"
ElseIf a = 1 Then
RiskCalc.RR_Score.Caption = UCase(wsRR.Range("H32"))
RisKRating.Label143.Caption = UCase(wsRR.Range("H32"))
wspGen.Range("genRR") = UCase(wsRR.Range("H32"))
wspGen.Range("genJHARiskRating") = UCase(wsRR.Range("H32"))
End If
End If
If Left(wsRR.Range("H32"), 5) Then
If a = 0 Then
RiskCalc.RR_Score.Caption = "ACCEPTABLE 06"
RisKRating.Label143.Caption = RiskCalc.RR_Score.Caption
wspGen.Range("genRR") = "ACCEPTABLE 06"
wspGen.Range("genJHARiskRating") = "ACCEPTABLE 06"
ElseIf a = 1 Then
RiskCalc.RR_Score.Caption = UCase(wsRR.Range("H32"))
RisKRating.Label143.Caption = UCase(wsRR.Range("H32"))
wspGen.Range("genRR") = UCase(wsRR.Range("H32"))
wspGen.Range("genJHARiskRating") = UCase(wsRR.Range("H32"))
End If
End If
End Sub
answered Nov 21 at 2:18
urdearboy
5,9282725
Those two big blocks at the end are essentially the same except for the first lines...
– Tim Williams
Nov 21 at 4:33
I noticed the trend but the bottom one only refers toRange("H32")so it's really unclear if these need to be separate. Mostly waiting for OP to acknowledged this has been seen since it's not a solution
– urdearboy
Nov 21 at 4:35
Thanks you two. I will test both solutions when I am back in the office this morning and let you know how it goes.
– Zack E
Nov 21 at 12:16
add a comment |
1
This is as close as I can get since I'm pretty sure I'm not following all your logic:
Sub ScoringUpdateAmounts()
Dim aScores As Range, wb As Workbook, wsRR As Worksheet
Dim a As Long, wspGen As Worksheet, cell As Range
Dim i As Long, v, numL As Long, numH As Long, rating, capt
Set wb = ThisWorkbook
Set wsRR = wb.Sheets("RiskRating")
Set wspGen = wb.Sheets("pGeneralInfo")
Set aScores = wsRR.Range("AllScores")
For Each cell In aScores
v = cell.Value
If IsNumeric(v) And Len(v) > 0 Then
If v > 0 And v <= 4 Then
numL = numL + 1
ElseIf v > 4 And v <= 8 Then
numH = numH + 1
End If
End If
Next cell
rating = UCase(wsRR.Range("H32").Value)
If rating Like "GOOD*" Or rating Like "PRIME*" Then
If numL > 0 Then
capt = "ACCEPTABLE 06"
ElseIf numL = 0 And numH > 0 Then
capt = rating
End If
End If
If Len(capt) > 0 Then
RiskCalc.RR_Score.Caption = capt
RisKRating.Label143.Caption = capt
wspGen.Range("genRR") = capt
wspGen.Range("genJHARiskRating") = capt
End If
End Sub
answered Nov 21 at 7:12
Tim Williams
85.1k96785
add a comment |
0
I liked the solution of not looping through the range and just using the Min function, and I also liked the way @TimWilliams used the rating variable, so I combined the two separate solutions with some edits for formatting of the labels and it works perfectly. Below is the code I ended up using. Thank you both for your patience and helping this novice out. Sorry I cannot check both answers you provided as a solution.
Sub LessThanFour()
Dim aScores As Range
Dim a As Long
Dim i As Long, rating, capt
Set wb = Application.ThisWorkbook
Set wsRR = wb.Sheets("RiskRating")
Set wspGen = wb.Sheets("pGeneralInfo")
Set aScores = wsRR.Range("AllScores")
If Application.WorksheetFunction.Min(aScores) <= 4 Then
a = 0
Else
a = 1
End If
rating = UCase(wsRR.Range("H32").Value)
If rating Like "GOOD*" Or rating Like "PRIME*" Then
If a = 0 Then
capt = "ACCEPTABLE 06"
Else
capt = rating
End If
End If
If Len(capt) > 0 Then
RiskCalc.RR_Score.Caption = capt
RisKRating.Label143.Caption = capt
wspGen.Range("genRR") = capt
wspGen.Range("genJHARiskRating") = capt
End If
With RiskCalc.RR_Score
.Visible = True
Select Case Right(capt, 1)
Case 1 To 3: .BackColor = vbRed
Case 4 To 5: .BackColor = vbYellow
Case 6 To 7: .BackColor = vbGreen
Case Is >= 8
.BackColor = RGB(0, 153, 255)
.ForeColor = vbWhite
End Select
.Font.Size = 20
.Font.Bold = True
.TextAlign = fmTextAlignCenter
.BorderStyle = fmBorderStyleSingle
End With
With RisKRating.Label143
.Visible = True
Select Case Right(capt, 1)
Case 1 To 3: .BackColor = vbRed
Case 4 To 5: .BackColor = vbYellow
Case 6 To 7: .BackColor = vbGreen
Case Is >= 8
.BackColor = RGB(0, 153, 255)
.ForeColor = vbWhite
End Select
.Font.Size = 16
.Font.Bold = True
.TextAlign = fmTextAlignCenter
.BorderStyle = fmBorderStyleSingle
End With
End Sub
answered Nov 21 at 14:53
Zack E
10310
add a comment |
Your Answer
StackExchange.ifUsing("editor", function () {
StackExchange.using("externalEditor", function () {
StackExchange.using("snippets", function () {
StackExchange.snippets.init();
});
});
}, "code-snippets");
StackExchange.ready(function() {
var channelOptions = {
tags: "".split(" "),
id: "1"
};
initTagRenderer("".split(" "), "".split(" "), channelOptions);
StackExchange.using("externalEditor", function() {
// Have to fire editor after snippets, if snippets enabled
if (StackExchange.settings.snippets.snippetsEnabled) {
StackExchange.using("snippets", function() {
createEditor();
});
}
else {
createEditor();
}
});
function createEditor() {
StackExchange.prepareEditor({
heartbeatType: 'answer',
autoActivateHeartbeat: false,
convertImagesToLinks: true,
noModals: true,
showLowRepImageUploadWarning: true,
reputationToPostImages: 10,
bindNavPrevention: true,
postfix: "",
imageUploader: {
brandingHtml: "Powered by u003ca class="icon-imgur-white" href="https://imgur.com/"u003eu003c/au003e",
contentPolicyHtml: "User contributions licensed under u003ca href="https://creativecommons.org/licenses/by-sa/3.0/"u003ecc by-sa 3.0 with attribution requiredu003c/au003e u003ca href="https://stackoverflow.com/legal/content-policy"u003e(content policy)u003c/au003e",
allowUrls: true
},
onDemand: true,
discardSelector: ".discard-answer"
,immediatelyShowMarkdownHelp:true
});
}
});
draft saved
draft discarded
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
StackExchange.ready(
function () {
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fstackoverflow.com%2fquestions%2f53402488%2floop-to-check-if-a-cell-value-meets-a-condtion%23new-answer', 'question_page');
}
);
Post as a guest
Required, but never shown
3 Answers
3
active
oldest
votes
3 Answers
3
active
oldest
votes
active
oldest
votes
active
oldest
votes
1
I doubt this will fix your problem, but this is too long for a comment.
I re-structured your code as it currently stands and removed redundant/unneeded lines.
There is something funky going on in your 1-8 loop. You may need to take a step back and re-think out the logic here.
If you just want to know if the range has a value below some threshold you can use Min function to do so and ditch the loop like so
If Application.WorksheetFunction.Min(aScores) <= 4 Then
a = 0
Else
a = 1
End If
Either way, easier to read/follow code tends to make debugging logic-errors much, much easier
Option Explicit
Sub ScoringUpdateAmounts()
Dim wsRR As Worksheet: Set wsRR = ThisWorkbook.Sheets("RiskRating")
Dim wspGen As Worksheet: Set wspGen = ThisWorkbook.Sheets("pGeneralInfo")
Dim aScores As Range, a As Integer, MyCell As Range
Set aScores = wsRR.Range("AllScores")
For Each MyCell In aScores
Select Case MyCell
Case 1, 2, 3, 5
a = 0
Case 5, 6, 7, 8
a = 1
End Select
Next MyCell
If Left(wsRR.Range("H32"), 4) = "GOOD" Then
If a = 0 Then
RiskCalc.RR_Score.Caption = "ACCEPTABLE 06"
RisKRating.Label143.Caption = RiskCalc.RR_Score.Caption
wspGen.Range("genRR") = "ACCEPTABLE 06"
wspGen.Range("genJHARiskRating") = "ACCEPTABLE 06"
ElseIf a = 1 Then
RiskCalc.RR_Score.Caption = UCase(wsRR.Range("H32"))
RisKRating.Label143.Caption = UCase(wsRR.Range("H32"))
wspGen.Range("genRR") = UCase(wsRR.Range("H32"))
wspGen.Range("genJHARiskRating") = UCase(wsRR.Range("H32"))
End If
End If
If Left(wsRR.Range("H32"), 5) Then
If a = 0 Then
RiskCalc.RR_Score.Caption = "ACCEPTABLE 06"
RisKRating.Label143.Caption = RiskCalc.RR_Score.Caption
wspGen.Range("genRR") = "ACCEPTABLE 06"
wspGen.Range("genJHARiskRating") = "ACCEPTABLE 06"
ElseIf a = 1 Then
RiskCalc.RR_Score.Caption = UCase(wsRR.Range("H32"))
RisKRating.Label143.Caption = UCase(wsRR.Range("H32"))
wspGen.Range("genRR") = UCase(wsRR.Range("H32"))
wspGen.Range("genJHARiskRating") = UCase(wsRR.Range("H32"))
End If
End If
End Sub
answered Nov 21 at 2:18
urdearboy
5,9282725
Those two big blocks at the end are essentially the same except for the first lines...
– Tim Williams
Nov 21 at 4:33
I noticed the trend but the bottom one only refers toRange("H32")so it's really unclear if these need to be separate. Mostly waiting for OP to acknowledged this has been seen since it's not a solution
– urdearboy
Nov 21 at 4:35
Thanks you two. I will test both solutions when I am back in the office this morning and let you know how it goes.
– Zack E
Nov 21 at 12:16
add a comment |
1
I doubt this will fix your problem, but this is too long for a comment.
I re-structured your code as it currently stands and removed redundant/unneeded lines.
There is something funky going on in your 1-8 loop. You may need to take a step back and re-think out the logic here.
If you just want to know if the range has a value below some threshold you can use Min function to do so and ditch the loop like so
If Application.WorksheetFunction.Min(aScores) <= 4 Then
a = 0
Else
a = 1
End If
Either way, easier to read/follow code tends to make debugging logic-errors much, much easier
Option Explicit
Sub ScoringUpdateAmounts()
Dim wsRR As Worksheet: Set wsRR = ThisWorkbook.Sheets("RiskRating")
Dim wspGen As Worksheet: Set wspGen = ThisWorkbook.Sheets("pGeneralInfo")
Dim aScores As Range, a As Integer, MyCell As Range
Set aScores = wsRR.Range("AllScores")
For Each MyCell In aScores
Select Case MyCell
Case 1, 2, 3, 5
a = 0
Case 5, 6, 7, 8
a = 1
End Select
Next MyCell
If Left(wsRR.Range("H32"), 4) = "GOOD" Then
If a = 0 Then
RiskCalc.RR_Score.Caption = "ACCEPTABLE 06"
RisKRating.Label143.Caption = RiskCalc.RR_Score.Caption
wspGen.Range("genRR") = "ACCEPTABLE 06"
wspGen.Range("genJHARiskRating") = "ACCEPTABLE 06"
ElseIf a = 1 Then
RiskCalc.RR_Score.Caption = UCase(wsRR.Range("H32"))
RisKRating.Label143.Caption = UCase(wsRR.Range("H32"))
wspGen.Range("genRR") = UCase(wsRR.Range("H32"))
wspGen.Range("genJHARiskRating") = UCase(wsRR.Range("H32"))
End If
End If
If Left(wsRR.Range("H32"), 5) Then
If a = 0 Then
RiskCalc.RR_Score.Caption = "ACCEPTABLE 06"
RisKRating.Label143.Caption = RiskCalc.RR_Score.Caption
wspGen.Range("genRR") = "ACCEPTABLE 06"
wspGen.Range("genJHARiskRating") = "ACCEPTABLE 06"
ElseIf a = 1 Then
RiskCalc.RR_Score.Caption = UCase(wsRR.Range("H32"))
RisKRating.Label143.Caption = UCase(wsRR.Range("H32"))
wspGen.Range("genRR") = UCase(wsRR.Range("H32"))
wspGen.Range("genJHARiskRating") = UCase(wsRR.Range("H32"))
End If
End If
End Sub
answered Nov 21 at 2:18
urdearboy
5,9282725
Those two big blocks at the end are essentially the same except for the first lines...
– Tim Williams
Nov 21 at 4:33
I noticed the trend but the bottom one only refers toRange("H32")so it's really unclear if these need to be separate. Mostly waiting for OP to acknowledged this has been seen since it's not a solution
– urdearboy
Nov 21 at 4:35
Thanks you two. I will test both solutions when I am back in the office this morning and let you know how it goes.
– Zack E
Nov 21 at 12:16
add a comment |
1
1
1
I doubt this will fix your problem, but this is too long for a comment.
I re-structured your code as it currently stands and removed redundant/unneeded lines.
There is something funky going on in your 1-8 loop. You may need to take a step back and re-think out the logic here.
If you just want to know if the range has a value below some threshold you can use Min function to do so and ditch the loop like so
If Application.WorksheetFunction.Min(aScores) <= 4 Then
a = 0
Else
a = 1
End If
Either way, easier to read/follow code tends to make debugging logic-errors much, much easier
Option Explicit
Sub ScoringUpdateAmounts()
Dim wsRR As Worksheet: Set wsRR = ThisWorkbook.Sheets("RiskRating")
Dim wspGen As Worksheet: Set wspGen = ThisWorkbook.Sheets("pGeneralInfo")
Dim aScores As Range, a As Integer, MyCell As Range
Set aScores = wsRR.Range("AllScores")
For Each MyCell In aScores
Select Case MyCell
Case 1, 2, 3, 5
a = 0
Case 5, 6, 7, 8
a = 1
End Select
Next MyCell
If Left(wsRR.Range("H32"), 4) = "GOOD" Then
If a = 0 Then
RiskCalc.RR_Score.Caption = "ACCEPTABLE 06"
RisKRating.Label143.Caption = RiskCalc.RR_Score.Caption
wspGen.Range("genRR") = "ACCEPTABLE 06"
wspGen.Range("genJHARiskRating") = "ACCEPTABLE 06"
ElseIf a = 1 Then
RiskCalc.RR_Score.Caption = UCase(wsRR.Range("H32"))
RisKRating.Label143.Caption = UCase(wsRR.Range("H32"))
wspGen.Range("genRR") = UCase(wsRR.Range("H32"))
wspGen.Range("genJHARiskRating") = UCase(wsRR.Range("H32"))
End If
End If
If Left(wsRR.Range("H32"), 5) Then
If a = 0 Then
RiskCalc.RR_Score.Caption = "ACCEPTABLE 06"
RisKRating.Label143.Caption = RiskCalc.RR_Score.Caption
wspGen.Range("genRR") = "ACCEPTABLE 06"
wspGen.Range("genJHARiskRating") = "ACCEPTABLE 06"
ElseIf a = 1 Then
RiskCalc.RR_Score.Caption = UCase(wsRR.Range("H32"))
RisKRating.Label143.Caption = UCase(wsRR.Range("H32"))
wspGen.Range("genRR") = UCase(wsRR.Range("H32"))
wspGen.Range("genJHARiskRating") = UCase(wsRR.Range("H32"))
End If
End If
End Sub
answered Nov 21 at 2:18
urdearboy
5,9282725
I doubt this will fix your problem, but this is too long for a comment.
I re-structured your code as it currently stands and removed redundant/unneeded lines.
There is something funky going on in your 1-8 loop. You may need to take a step back and re-think out the logic here.
If you just want to know if the range has a value below some threshold you can use Min function to do so and ditch the loop like so
If Application.WorksheetFunction.Min(aScores) <= 4 Then
a = 0
Else
a = 1
End If
Either way, easier to read/follow code tends to make debugging logic-errors much, much easier
Option Explicit
Sub ScoringUpdateAmounts()
Dim wsRR As Worksheet: Set wsRR = ThisWorkbook.Sheets("RiskRating")
Dim wspGen As Worksheet: Set wspGen = ThisWorkbook.Sheets("pGeneralInfo")
Dim aScores As Range, a As Integer, MyCell As Range
Set aScores = wsRR.Range("AllScores")
For Each MyCell In aScores
Select Case MyCell
Case 1, 2, 3, 5
a = 0
Case 5, 6, 7, 8
a = 1
End Select
Next MyCell
If Left(wsRR.Range("H32"), 4) = "GOOD" Then
If a = 0 Then
RiskCalc.RR_Score.Caption = "ACCEPTABLE 06"
RisKRating.Label143.Caption = RiskCalc.RR_Score.Caption
wspGen.Range("genRR") = "ACCEPTABLE 06"
wspGen.Range("genJHARiskRating") = "ACCEPTABLE 06"
ElseIf a = 1 Then
RiskCalc.RR_Score.Caption = UCase(wsRR.Range("H32"))
RisKRating.Label143.Caption = UCase(wsRR.Range("H32"))
wspGen.Range("genRR") = UCase(wsRR.Range("H32"))
wspGen.Range("genJHARiskRating") = UCase(wsRR.Range("H32"))
End If
End If
If Left(wsRR.Range("H32"), 5) Then
If a = 0 Then
RiskCalc.RR_Score.Caption = "ACCEPTABLE 06"
RisKRating.Label143.Caption = RiskCalc.RR_Score.Caption
wspGen.Range("genRR") = "ACCEPTABLE 06"
wspGen.Range("genJHARiskRating") = "ACCEPTABLE 06"
ElseIf a = 1 Then
RiskCalc.RR_Score.Caption = UCase(wsRR.Range("H32"))
RisKRating.Label143.Caption = UCase(wsRR.Range("H32"))
wspGen.Range("genRR") = UCase(wsRR.Range("H32"))
wspGen.Range("genJHARiskRating") = UCase(wsRR.Range("H32"))
End If
End If
End Sub
answered Nov 21 at 2:18
urdearboy
5,9282725
edited Nov 21 at 2:24
answered Nov 21 at 2:18
urdearboy
5,9282725
answered Nov 21 at 2:18
urdearboy
5,9282725
answered Nov 21 at 2:18
urdearboy
5,9282725
5,9282725
Those two big blocks at the end are essentially the same except for the first lines...
– Tim Williams
Nov 21 at 4:33
I noticed the trend but the bottom one only refers toRange("H32")so it's really unclear if these need to be separate. Mostly waiting for OP to acknowledged this has been seen since it's not a solution
– urdearboy
Nov 21 at 4:35
Thanks you two. I will test both solutions when I am back in the office this morning and let you know how it goes.
– Zack E
Nov 21 at 12:16
add a comment |
Those two big blocks at the end are essentially the same except for the first lines...
– Tim Williams
Nov 21 at 4:33
I noticed the trend but the bottom one only refers toRange("H32")so it's really unclear if these need to be separate. Mostly waiting for OP to acknowledged this has been seen since it's not a solution
– urdearboy
Nov 21 at 4:35
Thanks you two. I will test both solutions when I am back in the office this morning and let you know how it goes.
– Zack E
Nov 21 at 12:16
Those two big blocks at the end are essentially the same except for the first lines...
– Tim Williams
Nov 21 at 4:33
Those two big blocks at the end are essentially the same except for the first lines...
– Tim Williams
Nov 21 at 4:33
I noticed the trend but the bottom one only refers to
Range("H32") so it's really unclear if these need to be separate. Mostly waiting for OP to acknowledged this has been seen since it's not a solution– urdearboy
Nov 21 at 4:35
I noticed the trend but the bottom one only refers to
Range("H32") so it's really unclear if these need to be separate. Mostly waiting for OP to acknowledged this has been seen since it's not a solution– urdearboy
Nov 21 at 4:35
Thanks you two. I will test both solutions when I am back in the office this morning and let you know how it goes.
– Zack E
Nov 21 at 12:16
Thanks you two. I will test both solutions when I am back in the office this morning and let you know how it goes.
– Zack E
Nov 21 at 12:16
add a comment |
1
This is as close as I can get since I'm pretty sure I'm not following all your logic:
Sub ScoringUpdateAmounts()
Dim aScores As Range, wb As Workbook, wsRR As Worksheet
Dim a As Long, wspGen As Worksheet, cell As Range
Dim i As Long, v, numL As Long, numH As Long, rating, capt
Set wb = ThisWorkbook
Set wsRR = wb.Sheets("RiskRating")
Set wspGen = wb.Sheets("pGeneralInfo")
Set aScores = wsRR.Range("AllScores")
For Each cell In aScores
v = cell.Value
If IsNumeric(v) And Len(v) > 0 Then
If v > 0 And v <= 4 Then
numL = numL + 1
ElseIf v > 4 And v <= 8 Then
numH = numH + 1
End If
End If
Next cell
rating = UCase(wsRR.Range("H32").Value)
If rating Like "GOOD*" Or rating Like "PRIME*" Then
If numL > 0 Then
capt = "ACCEPTABLE 06"
ElseIf numL = 0 And numH > 0 Then
capt = rating
End If
End If
If Len(capt) > 0 Then
RiskCalc.RR_Score.Caption = capt
RisKRating.Label143.Caption = capt
wspGen.Range("genRR") = capt
wspGen.Range("genJHARiskRating") = capt
End If
End Sub
answered Nov 21 at 7:12
Tim Williams
85.1k96785
add a comment |
1
This is as close as I can get since I'm pretty sure I'm not following all your logic:
Sub ScoringUpdateAmounts()
Dim aScores As Range, wb As Workbook, wsRR As Worksheet
Dim a As Long, wspGen As Worksheet, cell As Range
Dim i As Long, v, numL As Long, numH As Long, rating, capt
Set wb = ThisWorkbook
Set wsRR = wb.Sheets("RiskRating")
Set wspGen = wb.Sheets("pGeneralInfo")
Set aScores = wsRR.Range("AllScores")
For Each cell In aScores
v = cell.Value
If IsNumeric(v) And Len(v) > 0 Then
If v > 0 And v <= 4 Then
numL = numL + 1
ElseIf v > 4 And v <= 8 Then
numH = numH + 1
End If
End If
Next cell
rating = UCase(wsRR.Range("H32").Value)
If rating Like "GOOD*" Or rating Like "PRIME*" Then
If numL > 0 Then
capt = "ACCEPTABLE 06"
ElseIf numL = 0 And numH > 0 Then
capt = rating
End If
End If
If Len(capt) > 0 Then
RiskCalc.RR_Score.Caption = capt
RisKRating.Label143.Caption = capt
wspGen.Range("genRR") = capt
wspGen.Range("genJHARiskRating") = capt
End If
End Sub
answered Nov 21 at 7:12
Tim Williams
85.1k96785
add a comment |
1
1
1
This is as close as I can get since I'm pretty sure I'm not following all your logic:
Sub ScoringUpdateAmounts()
Dim aScores As Range, wb As Workbook, wsRR As Worksheet
Dim a As Long, wspGen As Worksheet, cell As Range
Dim i As Long, v, numL As Long, numH As Long, rating, capt
Set wb = ThisWorkbook
Set wsRR = wb.Sheets("RiskRating")
Set wspGen = wb.Sheets("pGeneralInfo")
Set aScores = wsRR.Range("AllScores")
For Each cell In aScores
v = cell.Value
If IsNumeric(v) And Len(v) > 0 Then
If v > 0 And v <= 4 Then
numL = numL + 1
ElseIf v > 4 And v <= 8 Then
numH = numH + 1
End If
End If
Next cell
rating = UCase(wsRR.Range("H32").Value)
If rating Like "GOOD*" Or rating Like "PRIME*" Then
If numL > 0 Then
capt = "ACCEPTABLE 06"
ElseIf numL = 0 And numH > 0 Then
capt = rating
End If
End If
If Len(capt) > 0 Then
RiskCalc.RR_Score.Caption = capt
RisKRating.Label143.Caption = capt
wspGen.Range("genRR") = capt
wspGen.Range("genJHARiskRating") = capt
End If
End Sub
answered Nov 21 at 7:12
Tim Williams
85.1k96785
This is as close as I can get since I'm pretty sure I'm not following all your logic:
Sub ScoringUpdateAmounts()
Dim aScores As Range, wb As Workbook, wsRR As Worksheet
Dim a As Long, wspGen As Worksheet, cell As Range
Dim i As Long, v, numL As Long, numH As Long, rating, capt
Set wb = ThisWorkbook
Set wsRR = wb.Sheets("RiskRating")
Set wspGen = wb.Sheets("pGeneralInfo")
Set aScores = wsRR.Range("AllScores")
For Each cell In aScores
v = cell.Value
If IsNumeric(v) And Len(v) > 0 Then
If v > 0 And v <= 4 Then
numL = numL + 1
ElseIf v > 4 And v <= 8 Then
numH = numH + 1
End If
End If
Next cell
rating = UCase(wsRR.Range("H32").Value)
If rating Like "GOOD*" Or rating Like "PRIME*" Then
If numL > 0 Then
capt = "ACCEPTABLE 06"
ElseIf numL = 0 And numH > 0 Then
capt = rating
End If
End If
If Len(capt) > 0 Then
RiskCalc.RR_Score.Caption = capt
RisKRating.Label143.Caption = capt
wspGen.Range("genRR") = capt
wspGen.Range("genJHARiskRating") = capt
End If
End Sub
answered Nov 21 at 7:12
Tim Williams
85.1k96785
answered Nov 21 at 7:12
Tim Williams
85.1k96785
answered Nov 21 at 7:12
Tim Williams
85.1k96785
answered Nov 21 at 7:12
Tim Williams
85.1k96785
85.1k96785
add a comment |
add a comment |
0
I liked the solution of not looping through the range and just using the Min function, and I also liked the way @TimWilliams used the rating variable, so I combined the two separate solutions with some edits for formatting of the labels and it works perfectly. Below is the code I ended up using. Thank you both for your patience and helping this novice out. Sorry I cannot check both answers you provided as a solution.
Sub LessThanFour()
Dim aScores As Range
Dim a As Long
Dim i As Long, rating, capt
Set wb = Application.ThisWorkbook
Set wsRR = wb.Sheets("RiskRating")
Set wspGen = wb.Sheets("pGeneralInfo")
Set aScores = wsRR.Range("AllScores")
If Application.WorksheetFunction.Min(aScores) <= 4 Then
a = 0
Else
a = 1
End If
rating = UCase(wsRR.Range("H32").Value)
If rating Like "GOOD*" Or rating Like "PRIME*" Then
If a = 0 Then
capt = "ACCEPTABLE 06"
Else
capt = rating
End If
End If
If Len(capt) > 0 Then
RiskCalc.RR_Score.Caption = capt
RisKRating.Label143.Caption = capt
wspGen.Range("genRR") = capt
wspGen.Range("genJHARiskRating") = capt
End If
With RiskCalc.RR_Score
.Visible = True
Select Case Right(capt, 1)
Case 1 To 3: .BackColor = vbRed
Case 4 To 5: .BackColor = vbYellow
Case 6 To 7: .BackColor = vbGreen
Case Is >= 8
.BackColor = RGB(0, 153, 255)
.ForeColor = vbWhite
End Select
.Font.Size = 20
.Font.Bold = True
.TextAlign = fmTextAlignCenter
.BorderStyle = fmBorderStyleSingle
End With
With RisKRating.Label143
.Visible = True
Select Case Right(capt, 1)
Case 1 To 3: .BackColor = vbRed
Case 4 To 5: .BackColor = vbYellow
Case 6 To 7: .BackColor = vbGreen
Case Is >= 8
.BackColor = RGB(0, 153, 255)
.ForeColor = vbWhite
End Select
.Font.Size = 16
.Font.Bold = True
.TextAlign = fmTextAlignCenter
.BorderStyle = fmBorderStyleSingle
End With
End Sub
answered Nov 21 at 14:53
Zack E
10310
add a comment |
0
I liked the solution of not looping through the range and just using the Min function, and I also liked the way @TimWilliams used the rating variable, so I combined the two separate solutions with some edits for formatting of the labels and it works perfectly. Below is the code I ended up using. Thank you both for your patience and helping this novice out. Sorry I cannot check both answers you provided as a solution.
Sub LessThanFour()
Dim aScores As Range
Dim a As Long
Dim i As Long, rating, capt
Set wb = Application.ThisWorkbook
Set wsRR = wb.Sheets("RiskRating")
Set wspGen = wb.Sheets("pGeneralInfo")
Set aScores = wsRR.Range("AllScores")
If Application.WorksheetFunction.Min(aScores) <= 4 Then
a = 0
Else
a = 1
End If
rating = UCase(wsRR.Range("H32").Value)
If rating Like "GOOD*" Or rating Like "PRIME*" Then
If a = 0 Then
capt = "ACCEPTABLE 06"
Else
capt = rating
End If
End If
If Len(capt) > 0 Then
RiskCalc.RR_Score.Caption = capt
RisKRating.Label143.Caption = capt
wspGen.Range("genRR") = capt
wspGen.Range("genJHARiskRating") = capt
End If
With RiskCalc.RR_Score
.Visible = True
Select Case Right(capt, 1)
Case 1 To 3: .BackColor = vbRed
Case 4 To 5: .BackColor = vbYellow
Case 6 To 7: .BackColor = vbGreen
Case Is >= 8
.BackColor = RGB(0, 153, 255)
.ForeColor = vbWhite
End Select
.Font.Size = 20
.Font.Bold = True
.TextAlign = fmTextAlignCenter
.BorderStyle = fmBorderStyleSingle
End With
With RisKRating.Label143
.Visible = True
Select Case Right(capt, 1)
Case 1 To 3: .BackColor = vbRed
Case 4 To 5: .BackColor = vbYellow
Case 6 To 7: .BackColor = vbGreen
Case Is >= 8
.BackColor = RGB(0, 153, 255)
.ForeColor = vbWhite
End Select
.Font.Size = 16
.Font.Bold = True
.TextAlign = fmTextAlignCenter
.BorderStyle = fmBorderStyleSingle
End With
End Sub
answered Nov 21 at 14:53
Zack E
10310
add a comment |
0
0
0
I liked the solution of not looping through the range and just using the Min function, and I also liked the way @TimWilliams used the rating variable, so I combined the two separate solutions with some edits for formatting of the labels and it works perfectly. Below is the code I ended up using. Thank you both for your patience and helping this novice out. Sorry I cannot check both answers you provided as a solution.
Sub LessThanFour()
Dim aScores As Range
Dim a As Long
Dim i As Long, rating, capt
Set wb = Application.ThisWorkbook
Set wsRR = wb.Sheets("RiskRating")
Set wspGen = wb.Sheets("pGeneralInfo")
Set aScores = wsRR.Range("AllScores")
If Application.WorksheetFunction.Min(aScores) <= 4 Then
a = 0
Else
a = 1
End If
rating = UCase(wsRR.Range("H32").Value)
If rating Like "GOOD*" Or rating Like "PRIME*" Then
If a = 0 Then
capt = "ACCEPTABLE 06"
Else
capt = rating
End If
End If
If Len(capt) > 0 Then
RiskCalc.RR_Score.Caption = capt
RisKRating.Label143.Caption = capt
wspGen.Range("genRR") = capt
wspGen.Range("genJHARiskRating") = capt
End If
With RiskCalc.RR_Score
.Visible = True
Select Case Right(capt, 1)
Case 1 To 3: .BackColor = vbRed
Case 4 To 5: .BackColor = vbYellow
Case 6 To 7: .BackColor = vbGreen
Case Is >= 8
.BackColor = RGB(0, 153, 255)
.ForeColor = vbWhite
End Select
.Font.Size = 20
.Font.Bold = True
.TextAlign = fmTextAlignCenter
.BorderStyle = fmBorderStyleSingle
End With
With RisKRating.Label143
.Visible = True
Select Case Right(capt, 1)
Case 1 To 3: .BackColor = vbRed
Case 4 To 5: .BackColor = vbYellow
Case 6 To 7: .BackColor = vbGreen
Case Is >= 8
.BackColor = RGB(0, 153, 255)
.ForeColor = vbWhite
End Select
.Font.Size = 16
.Font.Bold = True
.TextAlign = fmTextAlignCenter
.BorderStyle = fmBorderStyleSingle
End With
End Sub
answered Nov 21 at 14:53
Zack E
10310
I liked the solution of not looping through the range and just using the Min function, and I also liked the way @TimWilliams used the rating variable, so I combined the two separate solutions with some edits for formatting of the labels and it works perfectly. Below is the code I ended up using. Thank you both for your patience and helping this novice out. Sorry I cannot check both answers you provided as a solution.
Sub LessThanFour()
Dim aScores As Range
Dim a As Long
Dim i As Long, rating, capt
Set wb = Application.ThisWorkbook
Set wsRR = wb.Sheets("RiskRating")
Set wspGen = wb.Sheets("pGeneralInfo")
Set aScores = wsRR.Range("AllScores")
If Application.WorksheetFunction.Min(aScores) <= 4 Then
a = 0
Else
a = 1
End If
rating = UCase(wsRR.Range("H32").Value)
If rating Like "GOOD*" Or rating Like "PRIME*" Then
If a = 0 Then
capt = "ACCEPTABLE 06"
Else
capt = rating
End If
End If
If Len(capt) > 0 Then
RiskCalc.RR_Score.Caption = capt
RisKRating.Label143.Caption = capt
wspGen.Range("genRR") = capt
wspGen.Range("genJHARiskRating") = capt
End If
With RiskCalc.RR_Score
.Visible = True
Select Case Right(capt, 1)
Case 1 To 3: .BackColor = vbRed
Case 4 To 5: .BackColor = vbYellow
Case 6 To 7: .BackColor = vbGreen
Case Is >= 8
.BackColor = RGB(0, 153, 255)
.ForeColor = vbWhite
End Select
.Font.Size = 20
.Font.Bold = True
.TextAlign = fmTextAlignCenter
.BorderStyle = fmBorderStyleSingle
End With
With RisKRating.Label143
.Visible = True
Select Case Right(capt, 1)
Case 1 To 3: .BackColor = vbRed
Case 4 To 5: .BackColor = vbYellow
Case 6 To 7: .BackColor = vbGreen
Case Is >= 8
.BackColor = RGB(0, 153, 255)
.ForeColor = vbWhite
End Select
.Font.Size = 16
.Font.Bold = True
.TextAlign = fmTextAlignCenter
.BorderStyle = fmBorderStyleSingle
End With
End Sub
answered Nov 21 at 14:53
Zack E
10310
answered Nov 21 at 14:53
Zack E
10310
answered Nov 21 at 14:53
Zack E
10310
answered Nov 21 at 14:53
Zack E
10310
10310
add a comment |
add a comment |
draft saved
draft discarded
Thanks for contributing an answer to Stack Overflow!
- Please be sure to answer the question. Provide details and share your research!
But avoid …
- Asking for help, clarification, or responding to other answers.
- Making statements based on opinion; back them up with references or personal experience.
To learn more, see our tips on writing great answers.
Some of your past answers have not been well-received, and you're in danger of being blocked from answering.
Please pay close attention to the following guidance:
- Please be sure to answer the question. Provide details and share your research!
But avoid …
- Asking for help, clarification, or responding to other answers.
- Making statements based on opinion; back them up with references or personal experience.
To learn more, see our tips on writing great answers.
draft saved
draft discarded
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
StackExchange.ready(
function () {
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fstackoverflow.com%2fquestions%2f53402488%2floop-to-check-if-a-cell-value-meets-a-condtion%23new-answer', 'question_page');
}
);
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
What is the purpose of the
For i = 1 To 4andFor i = 5 To 8loops? You'll only end up a value ofafor the last cell inaScores.– Comintern
Nov 20 at 22:27
What range corresponds to
aScores?– Tim Williams
Nov 20 at 22:29
If any of the cells in range
aScoresare <= 4 then I wanta=0so i can define the text boxes and some other ranges with the appropriate value. I hope that makes sense.– Zack E
Nov 20 at 22:29
@TimWilliams
Dim wb As Workbook Dim wsRR As Worksheet Set aScores = wsRR.Range("AllScores")– Zack E
Nov 20 at 22:30
Yes that's obvious from your code, but what range is
AllScores?– Tim Williams
Nov 20 at 22:31