Contitional formatting

PonPending · #1 (**permalink**) 10-30-08, 20:43

I have a spreadsheet that has range of cells that contain two types of data. The cell will have the word "OnTime" or it will contain a number, or it will be blank.

Starting at the first cell in the range, moving left to right, I want to do the following:

Examine the cell
If the cell is blank, move to the next cell in the range
If the cell contains "OnTime", blank out the cell, make a border around it and shade it green
If the cell contains a number, leave the number, make a border around it and shade it red

Do this for every cell in the range.

I know some macro code from recording then going back and tweaking it, but I don't know how to iterate through a range of cells, examine each, then do the above steps.

Can anyone point me in the right direction?

Thanks!!!

weejas · #2 (**permalink**) 10-31-08, 10:35

Look in the Help file for For Each...Next loops.

PonPending · #3 (**permalink**) 10-31-08, 12:00

Quote:

Originally Posted by weejas

Look in the Help file for For Each...Next loops.

Yeah a few minutes after posting i found code that pointed me in the right direction. Google is much better than the help file

The problem i'm having is the border is applying to the entire selection as opposed to the individual cells I iterate through.. just code tweaks at this point.. but thanks for the suggestion.. i wouldn't have thought to look in the help file.

weejas · #4 (**permalink**) 10-31-08, 12:11

Google is your friend!

Why not post what you've got? I've used a few For Each...Next loops in the past, so I might spot something. It sounds like the difference between the parent range and the child cells is being missed out.

PonPending · #5 (**permalink**) 10-31-08, 16:19

Ugh I broke it. It makes everything Green now.. i took out the border code.

Code:

Sub FormatMyRange()
   Range("E16:H19").Select
       
   If TypeName(Selection) <> "Range" Then Exit Sub
       
   For Each cell In Selection
   
      If ActiveCell.Value = "OnTime" Then
         With Selection.Interior
            .ColorIndex = 4
            .Pattern = xlSolid
         End With
      End If
      
     
   Next cell
       
End Sub

weejas · #6 (**permalink**) 11-01-08, 13:29

Put the "Border" bit back in, and change the "Selection" in the "With" clause to "ActiveCell".

As I mentioned, attach your file and we'll have a look at it.

PonPending · #7 (**permalink**) 11-03-08, 10:03

Here's the macro.. it's almost working but it seems to not test the conditions right. This is the code but it's also in the attached file.

The macro copies over some test values, and the worksheet itself shows what I'm trying to do...

Thanks!@!!

Code:

Sub GreenRedTransport()
    Range("F4:H6").Select
    Selection.Copy
    Range("B4").Select
    ActiveSheet.Paste
    Range("B4:D6").Select
    
    
    For Each Cell In Selection
    
        Cell.Borders(xlDiagonalDown).LineStyle = xlNone
        Cell.Borders(xlDiagonalUp).LineStyle = xlNone
        With Cell.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With Cell.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With Cell.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With Cell.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
    
    
    
        If (Cell.Value > 0 And Cell.Value <> "ONTIME") Then
            With Cell.Interior
                .ColorIndex = 3
                .Pattern = xlSolid
            End With
            With Cell
                .HorizontalAlignment = xlCenter
                .Font.Bold = True
            End With
        End If
        
        If Cell.Value = "ONTIME" Then
            With Selection.Interior
                .ColorIndex = 4
                .Pattern = xlSolid
            End With
            ActiveCell.ClearContents
        End If
      
    Next Cell
    
End Sub

PonPending · #8 (**permalink**) 11-03-08, 10:18

It's Working! Two lines changed here's the code:

Code:


Sub GreenRedTransport()
    Range("F4:H6").Select
    Selection.Copy
    Range("B4").Select
    ActiveSheet.Paste
    Range("B4:D6").Select
    
    
    For Each Cell In Selection
        
        Cell.Borders(xlDiagonalDown).LineStyle = xlNone
        Cell.Borders(xlDiagonalUp).LineStyle = xlNone
        With Cell.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With Cell.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With Cell.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
        With Cell.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
    
    
    
        If (Cell.Value > 0 And Cell.Value <> "ONTIME") Then
            With Cell.Interior
                .ColorIndex = 3
                .Pattern = xlSolid
            End With
            With Cell
                .HorizontalAlignment = xlCenter
                .Font.Bold = True
            End With
        End If
        
        If Cell.Value = "ONTIME" Then
            With Cell.Interior
                .ColorIndex = 4
                .Pattern = xlSolid
            End With
            Cell.Value = " "
        End If
      
    Next Cell
    
End Sub

Internet Services

Web Development

Digital Marketing

Consumer Tech