Consulting

Results 1 to 11 of 11

Thread: How to set a loop around a script?

  1. 05-20-2015, 08:37 AM #1
    Catotjuh91
    Catotjuh91 is offline
    VBAX Newbie
    Joined
    May 2015
    Posts
    1
    Location

    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.

    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
    Last edited by SamT; 05-20-2015 at 10:02 AM.
    Reply With Quote Reply With Quote
  2. 05-20-2015, 10:08 AM #2
    MINCUS1308
    MINCUS1308 is offline
    VBAX Tutor MINCUS1308's Avatar
    Joined
    Jun 2014
    Location
    UNDER MY DESK
    Posts
    254
    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
    - I HAVE NO IDEA WHAT I'M DOING
    Reply With Quote Reply With Quote
  3. 05-20-2015, 11:22 AM #3
    SamT
    SamT is offline
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location

    Post

    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
    Last edited by SamT; 05-20-2015 at 02:53 PM.
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ
    Reply With Quote Reply With Quote
  4. 05-20-2015, 12:22 PM #4
    MINCUS1308
    MINCUS1308 is offline
    VBAX Tutor MINCUS1308's Avatar
    Joined
    Jun 2014
    Location
    UNDER MY DESK
    Posts
    254
    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

    Thanks for catching that]
    Last edited by SamT; 05-20-2015 at 01:39 PM.
    - I HAVE NO IDEA WHAT I'M DOING
    Reply With Quote Reply With Quote
  5. 05-20-2015, 01:13 PM #5
    Paul_Hossler
    Paul_Hossler is offline
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,730
    Location
    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
    Last edited by SamT; 05-20-2015 at 02:54 PM.
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3
    Reply With Quote Reply With Quote
  6. 05-20-2015, 01:38 PM #6
    p45cal
    p45cal is offline
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,876
    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)
    Reply With Quote Reply With Quote
  7. 05-20-2015, 02:08 PM #7
    SamT
    SamT is offline
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    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.
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ
    Reply With Quote Reply With Quote
  8. 05-20-2015, 02:10 PM #8
    Paul_Hossler
    Paul_Hossler is offline
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,730
    Location
    Quote Originally Posted by p45cal View Post
    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
    Last edited by Paul_Hossler; 05-20-2015 at 02:26 PM.
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3
    Reply With Quote Reply With Quote
  9. 05-20-2015, 02:58 PM #9
    SamT
    SamT is offline
    Moderator VBAX Sage SamT's Avatar
    Joined
    Oct 2006
    Location
    Near Columbia
    Posts
    7,814
    Location
    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.

    But I am still leaving tha color constants up to Catotjuh
    I expect the student to do their homework and find all the errrors I leeve in.


    Please take the time to read the Forum FAQ
    Reply With Quote Reply With Quote
  10. 05-20-2015, 03:08 PM #10
    Paul_Hossler
    Paul_Hossler is offline
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,730
    Location
    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


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3
    Reply With Quote Reply With Quote
  11. 05-20-2015, 04:38 PM #11
    Paul_Hossler
    Paul_Hossler is offline
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,730
    Location
    There's also probably some clever way to use Filters, but I tend to the older fashion way
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3
    Reply With Quote Reply With Quote
« Previous Thread | Next Thread »

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  

Forum Rules