How to set a loop around a script?

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.

Code:

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

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

Code:

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

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

Code:

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.

Code:

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

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

Code:

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]

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

Code:

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

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)

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

Quote:

Originally Posted by 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)

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

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

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

Code:

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

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