How to set a loop around a script?

[Catotjuh91]

I have made the VBA script below.
With the script I can do every row by hand.
But I have around 5,000 rows, so I want to try to make a loop around it or something like that.
But I don't know how.
Can anybody help me?
Thank you.


Sub SetGrades()

Dim score As Integer

score = ActiveCell.Value

Select Case score

Case 0 To 50.3778337531486
ActiveCell(1, 2).Value = "TI"
ActiveCell(1, 2).HorizontalAlignment = xlCenter
ActiveCell(1, 2).Interior.Color = RGB(0, 255, 0)
ActiveCell(1, 3).Value = "No"
ActiveCell(1, 3).HorizontalAlignment = xlCenter

Case 50.3778337531487 To 176.32241813602
ActiveCell(1, 2).Value = "ARI"
ActiveCell(1, 2).HorizontalAlignment = xlCenter
ActiveCell(1, 2).Interior.Color = RGB(255, 0, 0)
ActiveCell(1, 3).Value = "No"
ActiveCell(1, 3).HorizontalAlignment = xlCenter

Case 176.32241813603 To 251.889168765743
ActiveCell(1, 2).Value = "PRI"
ActiveCell(1, 2).HorizontalAlignment = xlCenter
ActiveCell(1, 2).Interior.Color = RGB(255, 255, 0)
ActiveCell(1, 3).Value = "No"
ActiveCell(1, 3).HorizontalAlignment = xlCenter

Case 251.889168765744 To 302.267002518892
ActiveCell(1, 2).Value = "TI unknown"
ActiveCell(1, 2).HorizontalAlignment = xlCenter
ActiveCell(1, 2).Interior.Color = RGB(0, 255, 0)
ActiveCell(1, 3).Value = "No"
ActiveCell(1, 3).HorizontalAlignment = xlCenter

Case 302.267002518892 To 428.211586901763
ActiveCell(1, 2).Value = "ARI unknown"
ActiveCell(1, 2).HorizontalAlignment = xlCenter
ActiveCell(1, 2).Interior.Color = RGB(255, 0, 0)
ActiveCell(1, 3).Value = "No"
ActiveCell(1, 3).HorizontalAlignment = xlCenter

Case 428.211586901764 To 503.778337531486
ActiveCell(1, 2).Value = "PRI unknown"
ActiveCell(1, 2).HorizontalAlignment = xlCenter
ActiveCell(1, 2).Interior.Color = RGB(255, 255, 0)
ActiveCell(1, 3).Value = "No"
ActiveCell(1, 3).HorizontalAlignment = xlCenter

Case 503.778337531487 To 508.816120906801
ActiveCell(1, 2).Value = "TI emergency"
ActiveCell(1, 2).HorizontalAlignment = xlCenter
ActiveCell(1, 2).Interior.Color = RGB(0, 255, 0)
ActiveCell(1, 3).Value = "Yes"
ActiveCell(1, 3).HorizontalAlignment = xlCenter

Case 508.816120906802 To 518.891687657431
ActiveCell(1, 2).Value = "ARI emergency"
ActiveCell(1, 2).HorizontalAlignment = xlCenter
ActiveCell(1, 2).Interior.Color = RGB(255, 0, 0)
ActiveCell(1, 3).Value = "Yes"
ActiveCell(1, 3).HorizontalAlignment = xlCenter

Case 518.891687657432 To 528.96725440806
ActiveCell(1, 2).Value = "PRI emergency"
ActiveCell(1, 2).HorizontalAlignment = xlCenter
ActiveCell(1, 2).Interior.Color = RGB(255, 255, 0)
ActiveCell(1, 3).Value = "Yes"
ActiveCell(1, 3).HorizontalAlignment = xlCenter

Case 528.96725440807 To 609.571788413098
ActiveCell(1, 2).Value = "SK"
ActiveCell(1, 2).HorizontalAlignment = xlCenter
ActiveCell(1, 2).Interior.Color = RGB(0, 0, 255)
ActiveCell(1, 3).Value = "No"
ActiveCell(1, 3).HorizontalAlignment = xlCenter

Case 609.571788413099 To 739.478589420655
ActiveCell(1, 2).Value = "FE"
ActiveCell(1, 2).HorizontalAlignment = xlCenter
ActiveCell(1, 2).Interior.Color = RGB(0, 255, 255)
ActiveCell(1, 3).Value = "No"
ActiveCell(1, 3).HorizontalAlignment = xlCenter

Case 739.478589420656 To 881.612090680101
ActiveCell(1, 2).Value = "PRF"
ActiveCell(1, 2).HorizontalAlignment = xlCenter
ActiveCell(1, 2).Interior.Color = RGB(255, 0, 255)
ActiveCell(1, 3).Value = "No"
ActiveCell(1, 3).HorizontalAlignment = xlCenter

Case 881.612090680102 To 982.367758186398
ActiveCell(1, 2).Value = "FRD"
ActiveCell(1, 2).HorizontalAlignment = xlCenter
ActiveCell(1, 2).Interior.Color = RGB(255, 153, 0)
ActiveCell(1, 3).Value = "No"
ActiveCell(1, 3).HorizontalAlignment = xlCenter

Case 982.367758186399 To 984.886649874055
ActiveCell(1, 2).Value = "SK emergency"
ActiveCell(1, 2).HorizontalAlignment = xlCenter
ActiveCell(1, 2).Interior.Color = RGB(0, 0, 255)
ActiveCell(1, 3).Value = "Yes"
ActiveCell(1, 3).HorizontalAlignment = xlCenter

Case 984.886649874056 To 989.92443324937
ActiveCell(1, 2).Value = "FE emergency"
ActiveCell(1, 2).HorizontalAlignment = xlCenter
ActiveCell(1, 2).Interior.Color = RGB(0, 255, 255)
ActiveCell(1, 3).Value = "Yes"
ActiveCell(1, 3).HorizontalAlignment = xlCenter

Case 989.92443324938 To 994.962216624685
ActiveCell(1, 2).Value = "PRF emergency"
ActiveCell(1, 2).HorizontalAlignment = xlCenter
ActiveCell(1, 2).Interior.Color = RGB(255, 0, 255)
ActiveCell(1, 3).Value = "Yes"
ActiveCell(1, 3).HorizontalAlignment = xlCenter

Case 994.962216624686 To 1000
ActiveCell(1, 2).Value = "FRD emergency"
ActiveCell(1, 2).HorizontalAlignment = xlCenter
ActiveCell(1, 2).Interios.Color = RGB(255, 153, 0)
ActiveCell(1, 3).Value = "Yes"
ActiveCell(1, 3).HorizontalAlignment = xlCenter

Case Else
MsgBox "No score entered"

End Select

End Sub

[MINCUS1308]

Without more information this is about the best I can do.
If you can tell me more about the file setup I might be able to do a little bit better. lol


Sub SetGrades()

Dim score As Integer

For i = 1 To 5000
score = ActiveCell(i, 1).Value

Select Case score
Case 0 To 50.3778337531486
ActiveCell(1, 2).Value = "TI"
ActiveCell(1, 2).HorizontalAlignment = xlCenter
ActiveCell(1, 2).Interior.Color = RGB(0, 255, 0)
ActiveCell(1, 3).Value = "No"
ActiveCell(1, 3).HorizontalAlignment = xlCenter

Case 50.3778337531487 To 176.32241813602
ActiveCell(1, 2).Value = "ARI"
ActiveCell(1, 2).HorizontalAlignment = xlCenter
ActiveCell(1, 2).Interior.Color = RGB(255, 0, 0)
ActiveCell(1, 3).Value = "No"
ActiveCell(1, 3).HorizontalAlignment = xlCenter

Case 176.32241813603 To 251.889168765743
ActiveCell(1, 2).Value = "PRI"
ActiveCell(1, 2).HorizontalAlignment = xlCenter
ActiveCell(1, 2).Interior.Color = RGB(255, 255, 0)
ActiveCell(1, 3).Value = "No"
ActiveCell(1, 3).HorizontalAlignment = xlCenter

Case 251.889168765744 To 302.267002518892
ActiveCell(1, 2).Value = "TI unknown"
ActiveCell(1, 2).HorizontalAlignment = xlCenter
ActiveCell(1, 2).Interior.Color = RGB(0, 255, 0)
ActiveCell(1, 3).Value = "No"
ActiveCell(1, 3).HorizontalAlignment = xlCenter

Case 302.267002518892 To 428.211586901763
ActiveCell(1, 2).Value = "ARI unknown"
ActiveCell(1, 2).HorizontalAlignment = xlCenter
ActiveCell(1, 2).Interior.Color = RGB(255, 0, 0)
ActiveCell(1, 3).Value = "No"
ActiveCell(1, 3).HorizontalAlignment = xlCenter

Case 428.211586901764 To 503.778337531486
ActiveCell(1, 2).Value = "PRI unknown"
ActiveCell(1, 2).HorizontalAlignment = xlCenter
ActiveCell(1, 2).Interior.Color = RGB(255, 255, 0)
ActiveCell(1, 3).Value = "No"
ActiveCell(1, 3).HorizontalAlignment = xlCenter

Case 503.778337531487 To 508.816120906801
ActiveCell(1, 2).Value = "TI emergency"
ActiveCell(1, 2).HorizontalAlignment = xlCenter
ActiveCell(1, 2).Interior.Color = RGB(0, 255, 0)
ActiveCell(1, 3).Value = "Yes"
ActiveCell(1, 3).HorizontalAlignment = xlCenter

Case 508.816120906802 To 518.891687657431
ActiveCell(1, 2).Value = "ARI emergency"
ActiveCell(1, 2).HorizontalAlignment = xlCenter
ActiveCell(1, 2).Interior.Color = RGB(255, 0, 0)
ActiveCell(1, 3).Value = "Yes"
ActiveCell(1, 3).HorizontalAlignment = xlCenter

Case 518.891687657432 To 528.96725440806
ActiveCell(1, 2).Value = "PRI emergency"
ActiveCell(1, 2).HorizontalAlignment = xlCenter
ActiveCell(1, 2).Interior.Color = RGB(255, 255, 0)
ActiveCell(1, 3).Value = "Yes"
ActiveCell(1, 3).HorizontalAlignment = xlCenter

Case 528.96725440807 To 609.571788413098
ActiveCell(1, 2).Value = "SK"
ActiveCell(1, 2).HorizontalAlignment = xlCenter
ActiveCell(1, 2).Interior.Color = RGB(0, 0, 255)
ActiveCell(1, 3).Value = "No"
ActiveCell(1, 3).HorizontalAlignment = xlCenter

Case 609.571788413099 To 739.478589420655
ActiveCell(1, 2).Value = "FE"
ActiveCell(1, 2).HorizontalAlignment = xlCenter
ActiveCell(1, 2).Interior.Color = RGB(0, 255, 255)
ActiveCell(1, 3).Value = "No"
ActiveCell(1, 3).HorizontalAlignment = xlCenter

Case 739.478589420656 To 881.612090680101
ActiveCell(1, 2).Value = "PRF"
ActiveCell(1, 2).HorizontalAlignment = xlCenter
ActiveCell(1, 2).Interior.Color = RGB(255, 0, 255)
ActiveCell(1, 3).Value = "No"
ActiveCell(1, 3).HorizontalAlignment = xlCenter

Case 881.612090680102 To 982.367758186398
ActiveCell(1, 2).Value = "FRD"
ActiveCell(1, 2).HorizontalAlignment = xlCenter
ActiveCell(1, 2).Interior.Color = RGB(255, 153, 0)
ActiveCell(1, 3).Value = "No"
ActiveCell(1, 3).HorizontalAlignment = xlCenter

Case 982.367758186399 To 984.886649874055
ActiveCell(1, 2).Value = "SK emergency"
ActiveCell(1, 2).HorizontalAlignment = xlCenter
ActiveCell(1, 2).Interior.Color = RGB(0, 0, 255)
ActiveCell(1, 3).Value = "Yes"
ActiveCell(1, 3).HorizontalAlignment = xlCenter

Case 984.886649874056 To 989.92443324937
ActiveCell(1, 2).Value = "FE emergency"
ActiveCell(1, 2).HorizontalAlignment = xlCenter
ActiveCell(1, 2).Interior.Color = RGB(0, 255, 255)
ActiveCell(1, 3).Value = "Yes"
ActiveCell(1, 3).HorizontalAlignment = xlCenter

Case 989.92443324938 To 994.962216624685
ActiveCell(1, 2).Value = "PRF emergency"
ActiveCell(1, 2).HorizontalAlignment = xlCenter
ActiveCell(1, 2).Interior.Color = RGB(255, 0, 255)
ActiveCell(1, 3).Value = "Yes"
ActiveCell(1, 3).HorizontalAlignment = xlCenter

Case 994.962216624686 To 1000
ActiveCell(1, 2).Value = "FRD emergency"
ActiveCell(1, 2).HorizontalAlignment = xlCenter
ActiveCell(1, 2).Interios.Color = RGB(255, 153, 0)
ActiveCell(1, 3).Value = "Yes"
ActiveCell(1, 3).HorizontalAlignment = xlCenter

Case Else
MsgBox "No score entered"
End Select
Next i


End Sub

[SamT]

Catutjah,

First let me welcome you to VBA Express, IMO the very best site for All Microsoft Office help.

I will make some major changes to the Select Case Statement, but you are going to have do some editing yourself, ie. Change the color lines.

First run this little sub to fin out what the Color indexes are. The ColorIndex number will be in the cell and the cell will be colored to that index


Sub GetColorIndex()
For i = 1 to 56

With ActiveSheet
With .Cells(i 1)
.Value = i
.Interior.ColorIndex = i
End With

.Range("C1").Interior.Color = RGB(255, 0, 0)
.Range("C1").Value = "255, 0, 0"

.Range("C2").Interior.Color = RGB(0, 255, 0)
.Range("C2").Value = "0, 255, 0"

.Range("C3").Interior.Color = RGB(0, 0, 255)
.Range("C3").Value = "0,0, 255"

.Range("C4").Interior.Color = RGB(255, 255, 0)
.Range("C4").Value = "255, 255, 0"

.Range("C5").Interior.Color = RGB(255, 0, 255)
.Range("C5").Value = "255, 0, 255"

.Range("C6").Interior.Color = RGB(255, 153, 0)
.Range("C6).Value = "255, 153, 0"

End With
End sub

In Sub SetGrades I give you, I am going to use dummy Constants. You will need to edit them to the color names and ColorIndex values you need. Then you will need to use Ctrl + H to replace all the " RGB( n, n, n) values in the code with the Constant Names.

You are using 3 columns, I am going to set the "Score" column to "A". Edit that as needed.



ub SetGrades()

Dim Score As Double
Dim ScoreRng As Range
Dim DeptCell As Range
Dim UrgentCell As Range
Dim Cel As Range
LastRow As Long

'ColorIndex Constants' Replace these with your choices/
Const Color1 As Long = 1
Const Color2 As Long = 2
Const Color3 As Long = 3
Const Color4 As Long = 4
Const Color5 As Long = 5
Const Color6 As Long = 6



With ActiveSheet
LastRow = .Cells(Rows.Count, 1).End(xlUp).Row '1 = Column #1
Set ScoreRng = .Range("A1:A" & CStr(LastRow))
.Columns("2:3").HorizontalAlignment = xlCenter

For Each Cel In ScoreRng
Set DeptCell = Cel.Offset(0, 1)
Sert UrgentCell = Cel.Offset(0, 2)
Score = Cel.Value

Case Is <= 50.3778337531486
DeptCell.Value = "TI"
DeptCell.Interior.ColorIndex = RGB(0, 255, 0) 'Replace RGB values as discussed
UrgentCell.Value = "No"
Case Is <= 176.32241813602
DeptCell.Value = "ARI"
DeptCell.Interior.ColorIndex = RGB(255, 0, 0)
UrgentCell.Value = "No"
Case Is <= 251.889168765743
DeptCell.Value = "PRI"
DeptCell.Interior.ColorIndex = RGB(255, 255, 0)
UrgentCell.Value = "No"
Case Is <= 302.267002518892
DeptCell.Value = "TI unknown"
DeptCell.Interior.ColorIndex = RGB(0, 255, 0)
UrgentCell.Value = "No"
Case Is <= 428.211586901763
DeptCell.Value = "ARI unknown"
DeptCell.Interior.ColorIndex = RGB(255, 0, 0)
UrgentCell.Value = "No"
Case Is <= 503.778337531486
DeptCell.Value = "PRI unknown"
DeptCell.Interior.ColorIndex = RGB(255, 255, 0)
UrgentCell.Value = "No"
Case Is <= 508.816120906801
DeptCell.Value = "TI emergency"
DeptCell.Interior.ColorIndex = RGB(0, 255, 0)
UrgentCell.Value = "Yes"
Case Is <= 518.891687657431
DeptCell.Value = "ARI emergency"
DeptCell.Interior.ColorIndex = RGB(255, 0, 0)
UrgentCell.Value = "Yes"
Case Is <= 528.96725440806
DeptCell.Value = "PRI emergency"
DeptCell.Interior.ColorIndex = RGB(255, 255, 0)
UrgentCell.Value = "Yes"
Case Is <= 609.571788413098
DeptCell.Value = "SK"
DeptCell.Interior.ColorIndex = RGB(0, 0, 255)
UrgentCell.Value = "No"
Case Is <= 739.478589420655
DeptCell.Value = "FE"
DeptCell.Interior.ColorIndex = RGB(0, 255, 255)
UrgentCell.Value = "No"
Case Is <= 881.612090680101
DeptCell.Value = "PRF"
DeptCell.Interior.ColorIndex = RGB(255, 0, 255)
UrgentCell.Value = "No"
Case Is <= 982.367758186398
DeptCell.Value = "FRD"
DeptCell.Interior.ColorIndex = RGB(255, 153, 0)
UrgentCell.Value = "No"
Case Is <= 984.886649874055
DeptCell.Value = "SK emergency"
DeptCell.Interior.ColorIndex = RGB(0, 0, 255)
UrgentCell.Value = "Yes"
Case Is <= 989.92443324937
DeptCell.Value = "FE emergency"
DeptCell.Interior.ColorIndex = RGB(0, 255, 255)
UrgentCell.Value = "Yes"
Case Is <= 994.962216624685
DeptCell.Value = "PRF emergency"
DeptCell.Interior.ColorIndex = RGB(255, 0, 255)
UrgentCell.Value = "Yes"
Case Is <= 1000
DeptCell.Value = "FRD emergency"
DeptCell.Interios.ColorIndex = RGB(255, 153, 0)
UrgentCell.Value = "Yes"
Case Else
MsgBox "No score entered in Row number" & CStr(Cel.Row)

End SelectNext Cel
End With
End Sub

[MINCUS1308]

SamT,

side note - I like the way you code. I always like looking at you code before i run it.
I was a little curious when i saw the for but no next. so i plopped it in the editor.
I think you lost your next i statement.

Catutjah,
I think this will work a little better for you


Sub GetColorIndex()
With ActiveSheet

For i = 1 To 56

With ActiveSheet
With .Cells(i, 1)
.Value = i
.Interior.ColorIndex = i
End With
Next i
.Range("C1").Interior.Color = RGB(255, 0, 0)
.Range("C1").Value = "255, 0, 0"

.Range("C2").Interior.Color = RGB(0, 255, 0)
.Range("C2").Value = "0, 255, 0"

.Range("C3").Interior.Color = RGB(0, 0, 255)
.Range("C3").Value = "0,0, 255"

.Range("C4").Interior.Color = RGB(255, 255, 0)
.Range("C4").Value = "255, 255, 0"

.Range("C5").Interior.Color = RGB(255, 0, 255)
.Range("C5").Value = "255, 0, 255"

.Range("C6").Interior.Color = RGB(255, 153, 0)
.Range("C6").Value = "255, 153, 0"

End With

End Sub
[SamT: I missed it, but you put it in the wrong place, Nya nya nya :D

Thanks for catching that]

[Paul_Hossler]

Yea, I like SamT's code also (but don't tell him ... we don't want him to get a swelled head)


This is a slight variation on it; not as elegant, but possibly easier for a less experienced macro writer to follow at first

There are 8 standard VBA.ColorConstants -- I used the ones that are standard, but had to define what seemed to be orange on my monitor



Option Explicit
Sub SetGrades_phh()

Const ciScoreCol As Long = 1
Const ciDeptCol As Long = 2
Const ciUrgentCol As Long = 3

Const ciOrange As Long = 39423 ' RGB(255, 153, 0)

Dim iStartRow As Long, iLastRow As Long, iRow As Long

With ActiveSheet
.Columns(ciDeptCol).HorizontalAlignment = xlCenter
.Columns(ciUrgentCol).HorizontalAlignment = xlCenter

iLastRow = .Cells(.Rows.Count, ciScoreCol).End(xlUp).Row '1 = Column #1

For iRow = iStartRow To iLastRow
Select Case .Cells(iRow, ciScoreCol).Value
Case Is <= 50.3778337531486
.Cells(iRow, ciDeptCol).Value = "TI"
.Cells(iRow, ciDeptCol).Interior.Color = vbGreen
.Cells(iRow, ciUrgentCol).Value = "No"
Case Is <= 176.32241813602
.Cells(iRow, ciDeptCol).Value = "ARI"
.Cells(iRow, ciDeptCol).Interior.Color = vbRed
.Cells(iRow, ciUrgentCol).Value = "No"
Case Is <= 251.889168765743
.Cells(iRow, ciDeptCol).Value = "PRI"
.Cells(iRow, ciDeptCol).Interior.Color = vbCyan
.Cells(iRow, ciUrgentCol).Value = "No"
Case Is <= 302.267002518892
.Cells(iRow, ciDeptCol).Value = "TI unknown"
.Cells(iRow, ciDeptCol).Interior.Color = vbGreen
.Cells(iRow, ciUrgentCol).Value = "No"
Case Is <= 428.211586901763
.Cells(iRow, ciDeptCol).Value = "ARI unknown"
.Cells(iRow, ciDeptCol).Interior.Color = vbRed
.Cells(iRow, ciUrgentCol).Value = "No"
Case Is <= 503.778337531486
.Cells(iRow, ciDeptCol).Value = "PRI unknown"
.Cells(iRow, ciDeptCol).Interior.Color = vbCyan
.Cells(iRow, ciUrgentCol).Value = "No"
Case Is <= 508.816120906801
.Cells(iRow, ciDeptCol).Value = "TI emergency"
.Cells(iRow, ciDeptCol).Interior.Color = vbGreen
.Cells(iRow, ciUrgentCol).Value = "Yes"
Case Is <= 518.891687657431
.Cells(iRow, ciDeptCol).Value = "ARI emergency"
.Cells(iRow, ciDeptCol).Interior.Color = vbRed
.Cells(iRow, ciUrgentCol).Value = "Yes"
Case Is <= 528.96725440806
.Cells(iRow, ciDeptCol).Value = "PRI emergency"
.Cells(iRow, ciDeptCol).Interior.Color = vbCyan
.Cells(iRow, ciUrgentCol).Value = "Yes"
Case Is <= 609.571788413098
.Cells(iRow, ciDeptCol).Value = "SK"
.Cells(iRow, ciDeptCol).Interior.Color = vbBlue
.Cells(iRow, ciUrgentCol).Value = "No"
Case Is <= 739.478589420655
.Cells(iRow, ciDeptCol).Value = "FE"
.Cells(iRow, ciDeptCol).Interior.Color = vbYellow
.Cells(iRow, ciUrgentCol).Value = "No"
Case Is <= 881.612090680101
.Cells(iRow, ciDeptCol).Value = "PRF"
.Cells(iRow, ciDeptCol).Interior.Color = vbMagenta
.Cells(iRow, ciUrgentCol).Value = "No"
Case Is <= 982.367758186398
.Cells(iRow, ciDeptCol).Value = "FRD"
.Cells(iRow, ciDeptCol).Interior.Color = ciOrange
.Cells(iRow, ciUrgentCol).Value = "No"
Case Is <= 984.886649874055
.Cells(iRow, ciDeptCol).Value = "SK emergency"
.Cells(iRow, ciDeptCol).Interior.Color = vbBlue
.Cells(iRow, ciUrgentCol).Value = "Yes"
Case Is <= 989.92443324937
.Cells(iRow, ciDeptCol).Value = "FE emergency"
.Cells(iRow, ciDeptCol).Interior.Color = vbYellow
.Cells(iRow, ciUrgentCol).Value = "Yes"
Case Is <= 994.962216624685
.Cells(iRow, ciDeptCol).Value = "PRF emergency"
.Cells(iRow, ciDeptCol).Interior.Color = vbMagenta
.Cells(iRow, ciUrgentCol).Value = "Yes"
Case Is <= 1000
.Cells(iRow, ciDeptCol).Value = "FRD emergency"
.Cells(iRow, ciDeptCol).Interios.Color = ciOrange
.Cells(iRow, ciUrgentCol).Value = "Yes"
Case Else
MsgBox "No score entered in Row number " & iRow

End Select
Next iRow
End With
End Sub

[p45cal]

With the Select Case statement, let's say the value is 500, isn't the first Case going to be executed (Is >= 50.3778337531486) rather than the 6th Case, and the rest of the cases just jumped over? Is that the intention? Or should all those >= be < with another tweak or two? (Or perhaps keep the greater-or-equal-to and reverse the order of the Cases) I've not tested this! (no Excel right now)

[SamT]

That's good, Paul, that he should know about the vbColorConstants. I usually assign the ColorIndex numbers to custom names like Urgent = 3 (Red) so the code gives an idea what the color means.

I didn't want to take the time to look up what colors he was using, co I only edited .Interior.Color to Interior.ColorIndex. I use UltraEdit for batch editing so that saved him a bit of time. took me 3 seconds to change every instance.

I use that little color code all the time to see what index numbers result in what colors.

Somewhere in my 100+ GB of backups, I have a workbook I developed with three modules and sheets, each with 256 named custom color constants. :dunno

[Paul_Hossler]

With the Select Case statement, let's say the value is 500, isn't the first Case going to be executed (Is >= 50.3778337531486) rather than the 6th Case, and the rest of the cases just jumped over? Is that the intention? Or should all those >= be < with another tweak or two? (Or perhaps keep the greater-or-equal-to and reverse the order of the Cases) I've not tested this! (no Excel right now)

I think you're correct

all the Case clauses should be <=

I also forgot to turn off screen updating

Normally, I'd have put all the values into a little WS list and Matched from that without all the Select Case

[SamT]

I am really tired, but I just can't stay away.
@ P45cal, Thanks, I changed it.
@ Paul, I changed your too, 'cuz it was just 5 or 6 clicks and a drag.

Maybe we can get a few more members in here and get it right. :banghead:

But I am still leaving tha color constants up to Catotjuh

[Paul_Hossler]

I was looking as some of the data values, and there is some built in data that can be used




Option Explicit
Option Base 1
Sub TryAgain()
Const ciScoreCol As Long = 1
Const ciDeptCol As Long = 2
Const ciUrgentCol As Long = 3

Const ciOrange As Long = 39423 ' RGB(255, 153, 0)

Dim iStartRow As Long, iLastRow As Long, iRow As Long, iMatch As Long
Dim vScore As Variant, vDept As Variant

vScore = Array(0, 50.37783375, 176.3224181, 251.8891688, 302.2670025, 428.2115869, 503.7783375, 508.8161209, _
518.8916877, 528.9672544, 609.5717884, 739.4785894, 881.6120907, 982.3677582, 984.8866499, _
989.9244332, 994.9622166)

vDept = Array("TI", "ARI", "PRI", "TI UNKNOWN", "ARI UNKNOWN", "PRI UNKNOWN", "TI EMERGENCY", "ARI EMERGENCY", "PRI EMERGENCY", _
"SK", "FE", "PRF", "FRD", "SK EMERGENCY", "FK EMERGENCY", "PRF EMERGENCY", "FRD EMERGENCY")

With ActiveSheet

.Columns(ciDeptCol).HorizontalAlignment = xlCenter
.Columns(ciUrgentCol).HorizontalAlignment = xlCenter

iLastRow = .Cells(.Rows.Count, ciScoreCol).End(xlUp).Row '1 = Column #1

Application.ScreenUpdating = False

For iRow = iStartRow To iLastRow
If Len(.Cells(iRow, ciScoreCol).Value) > 0 Then
iMatch = Application.WorksheetFunction.Match(.Cells(iRow, ciScoreCol).Value, vScore, 1)

.Cells(iRow, ciDeptCol).Value = vDept(iMatch)

If InStr(vDept(iMatch), "TI") > 0 Then
Cells(iRow, ciDeptCol).Interior.Color = vbGreen
ElseIf InStr(vDept(iMatch), "ARI") > 0 Then
Cells(iRow, ciDeptCol).Interior.Color = vbRed
ElseIf InStr(vDept(iMatch), "PRI") > 0 Then
Cells(iRow, ciDeptCol).Interior.Color = vbCyan
ElseIf InStr(vDept(iMatch), "SK") > 0 Then
Cells(iRow, ciDeptCol).Interior.Color = vbBlue
ElseIf InStr(vDept(iMatch), "FE") > 0 Then
Cells(iRow, ciDeptCol).Interior.Color = vbYellow
ElseIf InStr(vDept(iMatch), "PRF") > 0 Then
Cells(iRow, ciDeptCol).Interior.Color = vbMagenta
ElseIf InStr(vDept(iMatch), "FRD") > 0 Then
Cells(iRow, ciDeptCol).Interior.Color = ciOrange
End If
If InStr(vDept(iMatch), "EMERGENCY") > 0 Then
.Cells(iRow, ciUrgentCol).Value = "Yes"
Else
.Cells(iRow, ciUrgentCol).Value = "No"
End If
End If
Next iRow
End With

Application.ScreenUpdating = True


End Sub




I wish the OP had attached a small sample WB to test

[Paul_Hossler]

There's also probably some clever way to use Filters, but I tend to the older fashion way