Using VBA to select a row and colour code it based on conditions

Toonster

New Member
Joined
Feb 10, 2009
Messages
13
Hi,

I've had a look through the forum and can't see an answer, so apologies if I'm duplicating something!

I have a spreadsheet where column O has five conditions:
1 PO in
2 High Probability
3 Medium Probability
4 Low Probability
Blank

I need to colour code the whole row based on the value in the cells; if there were four conditions, I could do this with conditional formatting, but with five (with white as the fifth condition), I need to look at VBA.

However, I'm having difficulty colouring the whole row; how do I do this?

e.g. what I need to do is:
If O2 = "1 PO in"; Select A2:T2; Colour green

In addition, I need to ensure that if there is no data in column D, but column O is "1 PO in", it is highlighted in a separate colour. I have a macro for that, but don't know whether in needs to be put into the code before or after the macro needed above...

Many thanks in advance for your help!
 
Oooh - thank you (new command in VBA :biggrin: - I've not seen Else before...)

How does this work for:
Code:
Case Is = "1 In"
                    If oneCell.EntireRow.Range("E1") = "" Then
                        .ColorIndex = 3
                    Else
                        .ColorIndex = 4
                    End If

Here, I want only the cell in Column E to be red if it is blank.

I've tried putting in the
Code:
If Cells(i, 5) = "" Then
        Cells(i, 5).Interior.ColorIndex = 3 'red
        Else
        End If

from my original macro (replacing from If oneCell...), but got a Runtime Error 1004 Application Defined or Object-defined Error.
I've also tried just changing from Then, with the same result.
I'm not sure what I should be replacing it with - can you help?

Many thanks!
 
Upvote 0
I've also realised that I was an idiot, and didn't put in the
Code:
 Else
                    Cells(i, 5).Interior.ColorIndex = 4 'green
bit.

However, adding this in doesn't stop the macro breaking, plus I can't get the whole row to go green...
 
Upvote 0
What is the value of i when that error occurs?
Is the cell in column E a merged cell?

Those are the only two issues that I can think of that would cause error 1004 in that situation.
 
Upvote 0
Oh brilliant - thank you!
I realised that I didn't have in the
Code:
i = 2 'start row number
from Shyrath's original code...

Thank you for your help :-D
 
Upvote 0
{sigh} My lower lip is wobbling slightly - the code which was working fine this morning is now giving me errors all over the place!

Most common is Run-time Error '424': Object Required, which stops at this line:

Code:
For Each oneCell In Application.Intersect(keyRange, Range("A:A, Q:Q"))

I thought that the objects were set with this part of the code:
Code:
 i = 2 'start row number
  Dim keyRange As Range, oneCell As Range
          
    On Error Resume Next
        Set keyRange = Target
        Set keyRange = Application.Union(Target, Target.Dependents)
    On Error GoTo 0
    
    For Each oneCell In Application.Intersect(keyRange, Range("A:A, Q:Q"))

This is happening for any cell which isn't in column Q....

I'm not sure if the different types of macros I've got in here are 'clashing' (I'm really a total novice at this - I'm working my way though a book, but I've not got very far!), so below is the full code - I've tried to comment to make it easier to read, but in essence, the first half is to date stamp various cells when certain other cells are changed, and the second half is colour coding...

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range
    Application.EnableEvents = False
    
    'Date stamp Column A whenever a cell in the row is changed.
    For Each c In Target
                If c.Column > 1 And c.Column < 23 Then
            Cells(c.Row, 1) = Now
        End If
    
    'If Column Q turns to "1 In", change Column R to "1 PO In" and vice versa.
        If c.Column = 17 Then
            If c.Value = "1 In" Then
                  Cells(c.Row, 18) = "1 PO In"
            End If
        End If
        If c.Column = 18 Then
            If c.Value = "1 PO In" Then
                 Cells(c.Row, 17) = "1 In"
        End If
         End If
        
        'If Column Q changes to "1 In", Date stamp Column D and Column V.
        If c.Column = 17 Then
            If c.Value = "1 In" Then
                 Cells(c.Row, 22) = Now
        End If
    End If
        If c.Column = 17 Then
            If c.Value = "1 In" Then
                 Cells(c.Row, 4) = Now
        End If
    End If
    
    'If Column R changes to "1 PO In", date stamp Columns D and V.
        If c.Column = 18 Then
            If c.Value = "1 PO In" Then
                 Cells(c.Row, 22) = Now
        End If
    End If
          If c.Column = 18 Then
            If c.Value = "1 PO In" Then
                 Cells(c.Row, 4) = Now
        End If
    End If
    
    'If Column R changes to "4 Quotation sent", Date Stamp Column U
        If c.Column = 18 Then
            If c.Value = "4 Quotation sent" Then
                 Cells(c.Row, 21) = Now
        End If
        End If
        
    'If data is added to Column F, and there was not data there previously
    '(i.e the name has not been changed or updated), Date Stamp Column T.
    '(This is to give the date that the prospect was entered).
        If c.Column = 6 Then
        'If IsNull(c.Value) Then
            If c.Value <> "" And Cells(c.Row, 20) = "" Then
                 Cells(c.Row, 20) = Now
        End If
    End If
      Next c
      
   'Set colours for the cells dependent on the probability of getting the order.
      i = 2 'start row number
  Dim keyRange As Range, oneCell As Range
          
    On Error Resume Next
        Set keyRange = Target
        Set keyRange = Application.Union(Target, Target.Dependents)
    On Error GoTo 0
    
    For Each oneCell In Application.Intersect(keyRange, Range("A:A, Q:Q"))
    
        With oneCell.EntireRow.Range("A1:V1").Interior
            Rem test value from column Q
            Select Case CStr(oneCell.EntireRow.Range("Q1").Value)
                Case Is = "1 In"
                    .ColorIndex = 4 'green
                    If oneCell.EntireRow.Range("E1") = "" Then
                        Cells(i, 5).Interior.ColorIndex = 3 'red
                    Else
                        .ColorIndex = 4
                    End If
                Case Is = "2 High"
                    .ColorIndex = 44 'yellow
                Case Is = "3 Medium"
                    .ColorIndex = 46 'orange
                Case Is = "4 Low"
                    .ColorIndex = 3 'red
                Case Else
                    .ColorIndex = xlNone
                    
                    
            End Select
        End With
    i = i + 1
    Next oneCell
    

    Application.EnableEvents = True
End Sub

I've also conditionally formatted various columns to be grey - would that break it?

If anyone can point me to where I've gone wrong, I would be very greatful!

Many thanks in advance,
Jo
 
Upvote 0
I only dabble with VBA so still have lots to learn, i've tried using this but always get the same error that "i" and "c" "variable not defined...is this missing some variables? or am i doing something wrong?

Please help

hi,

try something more like this

Loop will continue as long as there is data in column O

Code:
Sub color()

i = 2 'start row number


For Each c In ActiveSheet.Range("O2:O" & Range("O" & Rows.Count).End(xlUp).Row)

    If Cells(i, 15) = "1 PO in" Then

        rng = "A" & i & ":" & "T" & i
        Range(rng).Interior.ColorIndex = 4 'green
        
        If Cells(i, 4) = "" Then
        Cells(i, 4).Interior.ColorIndex = 3 'red

        
    
        Else
                 
        End If
        
    End If
    i = i + 1
    
    Next c
    
    
End Sub
 
Upvote 0
HI

I get the same pb as Bench, and I can not find the solution.
it seems that the code from shyrath is the one I need, but I keep on getting the error saying that "i" and "c" "variable not defined.

tks for your help:)
 
Upvote 0

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top