Solved

Color Row on requirement

Posted on 2011-02-23
23
257 Views
Last Modified: 2012-08-14
Hello
I have a requirement below to create a excel Macro
In column D i have texts
15 Days, 30 Days, 45 Days, 60 Days, 90 Days,120 Days, Immidiate

Now i need to color cells based on the above text
1. 15 Days : color cell on the row at E,F column
2. 30 Days: color cell on the row at E,F column
3. 45 Days: color cell on the row at E,F,G column
4. 60 Days: color cell on the row at E,F,G column
5. 90 Days: color cell on the row at E,F,G,H column
6. 120 Days: color cell on the row at E,F,G,H,I column
7. Immidiate: color cell on the row at E,F,G,H,I,J column

i am providing a example file

 Format.xlsx
0
Comment
Question by:ExpertHelp79
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 8
  • 5
  • 3
  • +3
23 Comments
 
LVL 22

Expert Comment

by:Ivo Stoykov
ID: 34967943
try code attached

HTH

Ivo Stoykov
Sub setColor()
  Select Case Range("D" & ActiveCell.Row).Value
    Case "15 Days", "30 Days"
        Range("E" & ActiveCell.Row & ":F" & ActiveCell.Row).Select
    Case "45 Days", "60 Days"
        Range("E" & ActiveCell.Row & ":G" & ActiveCell.Row).Select
    Case "90 Days"
        Range("E" & ActiveCell.Row & ":H" & ActiveCell.Row).Select
    Case "120 Days"
        Range("E" & ActiveCell.Row & ":I" & ActiveCell.Row).Select
    Case "immidiate"
        Range("E" & ActiveCell.Row & ":J" & ActiveCell.Row).Select
  End Select
  With Selection.Interior
      .Pattern = xlSolid
      .PatternColorIndex = xlAutomatic
      .Color = 65535
      .TintAndShade = 0
      .PatternTintAndShade = 0
  End With
End Sub

Open in new window

0
 
LVL 16

Expert Comment

by:Peter Kwan
ID: 34967968
You need not to have a macro to do it. You may use conditional formatting with formula. Please see an example attached.
Format.xlsx
0
 
LVL 2

Author Comment

by:ExpertHelp79
ID: 34968041
ivostoykov:The macro is not working.. please test the same on the file i attached
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 2

Author Comment

by:ExpertHelp79
ID: 34968056
pkwan: The user may not use the same file so everytime he has to write CF on the new file. I want it a a macro
0
 
LVL 22

Expert Comment

by:Ivo Stoykov
ID: 34968124
work, if macros are enabled
see attached file

HTH

Ivo Stoykov Format.xlsm
0
 
LVL 2

Author Comment

by:ExpertHelp79
ID: 34968197
ivostoykov:macros are enabled at my end. And i am using the same file which you attached , its only coloring the first row
0
 
LVL 16

Expert Comment

by:Peter Kwan
ID: 34968376
Please try the attached.
Format.xlsm
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 34968512
What version of excel?

Chris
0
 
LVL 2

Author Comment

by:ExpertHelp79
ID: 34968539
2007
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 34968766
In that case the following macro adds the conditional formats to the used range on the first sheet as per your example.

Obviously you need to delete the cell fill first before you can see the CF results.  The range of application can of course be expanded to the full columns by replacing:

    Set rng = Intersect(Sheets(1).UsedRange, Sheets(1).Columns(5).Resize(, 2))
with
    Set rng = Sheets(1).Columns(5).Resize(, 2)


Chris
Sub Macro3()
Dim rng As Range
    
    Set rng = Intersect(Sheets(1).UsedRange, Sheets(1).Columns(5).Resize(, 2))
    With rng
        .Resize(, 7).FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=$D1=""15 Days"""
'        .FormatConditions(rng.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
        End With
         .FormatConditions(1).StopIfTrue = False
    
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=$D1=""30 Days"""
'        .FormatConditions(rng.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(2).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
        End With
         .FormatConditions(2).StopIfTrue = False
    
        .Resize(, 3).FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=$D1=""45 Days"""
'        .FormatConditions(rng.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(3).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
        End With
         .FormatConditions(3).StopIfTrue = False
    
        .Resize(, 4).FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=$D1=""60 Days"""
'        .FormatConditions(rng.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(4).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
        End With
         .FormatConditions(4).StopIfTrue = False
    
        .Resize(, 5).FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=$D1=""90 Days"""
'        .FormatConditions(rng.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(5).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
        End With
         .FormatConditions(5).StopIfTrue = False
    
        .Resize(, 6).FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=$D1=""120 Days"""
'        .FormatConditions(rng.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(6).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
        End With
         .FormatConditions(6).StopIfTrue = False
    
        .Resize(, 3).FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=$D1=""Immediate"""
'        .FormatConditions(rng.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(7).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
        End With
         .FormatConditions(7).StopIfTrue = False
    
    End With
End Sub

Open in new window

0
 
LVL 92

Assisted Solution

by:Patrick Matthews
Patrick Matthews earned 250 total points
ID: 34968886
Chris,

Setting Conditional Formatting formula-based rules that use relative references is one of the rare cases where you actually do have to select an appropriate range:

http://www.experts-exchange.com/blogs/matthewspatrick/B_2912-You-never-have-to-select-a-range-in-Excel-VBA-except-when-you-do-have-to.html

Re-writing your macro:

Sub Macro3()
Dim rng As Range
    
    [e2].Select
    
    Set rng = Intersect(Sheets(1).UsedRange, Sheets(1).Columns(5).Resize(, 2))
    With rng
        .Resize(, 7).FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=$D2=""15 Days"""
'        .FormatConditions(rng.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
        End With
         .FormatConditions(1).StopIfTrue = False
    
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=$D2=""30 Days"""
'        .FormatConditions(rng.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(2).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
        End With
         .FormatConditions(2).StopIfTrue = False
    
        .Resize(, 3).FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=$D2=""45 Days"""
'        .FormatConditions(rng.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(3).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
        End With
         .FormatConditions(3).StopIfTrue = False
    
        .Resize(, 4).FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=$D2=""60 Days"""
'        .FormatConditions(rng.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(4).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
        End With
         .FormatConditions(4).StopIfTrue = False
    
        .Resize(, 5).FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=$D2=""90 Days"""
'        .FormatConditions(rng.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(5).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
        End With
         .FormatConditions(5).StopIfTrue = False
    
        .Resize(, 6).FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=$D2=""120 Days"""
'        .FormatConditions(rng.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(6).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
        End With
         .FormatConditions(6).StopIfTrue = False
    
        .Resize(, 3).FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=$D2=""Immediate"""
'        .FormatConditions(rng.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(7).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
        End With
         .FormatConditions(7).StopIfTrue = False
    
    End With
End Sub

Open in new window


:)

Patrick
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 34968964
Patrick

Far be it from mer to argue ... but I did test teh implementation before posting with the selection in a random location ... and have retested with two different row/column selections before running the macro and it always works fine ... so I would have to dispute your statement ... in 2010 anyway!

Chris
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 34968978
ExpertHelp79

BTW, please do not be offended but I did set the rule to use the spelling of "Immediate" and hence unless you change the cell entry accordingly you would not see those rows update with the CF

Chris
0
 
LVL 92

Expert Comment

by:Patrick Matthews
ID: 34969007
Chris,

>>in 2010 anyway

My Office 2010 box is at home, so I am stuck with Office 2007 at the moment.  However, try this:

1) Select cell A18

2) Run your original macro

In Excel 2007, and presumably earlier versions too, the CF formulae will not render correctly.  Indeed, if I go to "Manage CF Rules" for E2, the formula for the first rule renders as =$D1048560="15 Days"

:)

Patrick
0
 
LVL 2

Author Comment

by:ExpertHelp79
ID: 34969019
chris_bottomley:Please give me sometime to test Thanks for the help
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 34969086
PAtrick

I have 2007 at home but my employer won't let me nip off.  At the very least it will do no harm to apply your additional line of

    [e2].Select

... as long as teh current is not subsequently used in which case the following re-asserts the conditions after the macro executes so should pick up your potential concern and avoid changing the original status as well

I ope to recall the issue when I get onto 2007 and check it out there just for my info

Chris
Sub Macro3()
Dim rng As Range
Dim sel As Range
Dim cel As Range
    
    Set sel = Selection
    Set cel = ActiveCell
    [e2].Select
    Set rng = Sheets(1).Columns(5).Resize(, 2)
    With rng
        .Resize(, 7).FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=$D1=""15 Days"""
'        .FormatConditions(rng.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
        End With
         .FormatConditions(1).StopIfTrue = False
    
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=$D1=""30 Days"""
'        .FormatConditions(rng.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(2).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
        End With
         .FormatConditions(2).StopIfTrue = False
    
        .Resize(, 3).FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=$D1=""45 Days"""
'        .FormatConditions(rng.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(3).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
        End With
         .FormatConditions(3).StopIfTrue = False
    
        .Resize(, 4).FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=$D1=""60 Days"""
'        .FormatConditions(rng.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(4).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
        End With
         .FormatConditions(4).StopIfTrue = False
    
        .Resize(, 5).FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=$D1=""90 Days"""
'        .FormatConditions(rng.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(5).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
        End With
         .FormatConditions(5).StopIfTrue = False
    
        .Resize(, 6).FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=$D1=""120 Days"""
'        .FormatConditions(rng.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(6).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
        End With
         .FormatConditions(6).StopIfTrue = False
    
        .Resize(, 3).FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=$D1=""Immediate"""
'        .FormatConditions(rng.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(7).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
        End With
         .FormatConditions(7).StopIfTrue = False
    
    End With
    sel.Select
    cel.Activate
End Sub

Open in new window

0
 
LVL 92

Expert Comment

by:Patrick Matthews
ID: 34969299
Chris,

If you select E2, then the CF formulae must refer to $d2 and not $d1.

If you select E1, then you would refer to $d1.

This is something I very much learned the hard way :)

Patrick
0
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 250 total points
ID: 34969408
Patrick

A simple typo ... as it were ... since your post presumably works on 2007 I include it here with the selection controls in teh anticipation it takes the best of both.

Chris

Again replace:

    Set rng = Sheets(1).Columns(5).Resize(, 2)
with
    Set rng = Intersect(Sheets(1).UsedRange, Sheets(1).Columns(5).Resize(, 2))

to apply to teh full columns rather than the usedrange
Sub Macro3()
Dim rng As Range
Dim sel As Range
Dim cel As Range
    
    Set sel = Selection
    Set cel = ActiveCell
    [e2].Select
    
    Set rng = Intersect(Sheets(1).UsedRange, Sheets(1).Columns(5).Resize(, 2))
    With rng
        .Resize(, 7).FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=$D2=""15 Days"""
'        .FormatConditions(rng.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
        End With
         .FormatConditions(1).StopIfTrue = False
    
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=$D2=""30 Days"""
'        .FormatConditions(rng.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(2).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
        End With
         .FormatConditions(2).StopIfTrue = False
    
        .Resize(, 3).FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=$D2=""45 Days"""
'        .FormatConditions(rng.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(3).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
        End With
         .FormatConditions(3).StopIfTrue = False
    
        .Resize(, 4).FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=$D2=""60 Days"""
'        .FormatConditions(rng.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(4).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
        End With
         .FormatConditions(4).StopIfTrue = False
    
        .Resize(, 5).FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=$D2=""90 Days"""
'        .FormatConditions(rng.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(5).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
        End With
         .FormatConditions(5).StopIfTrue = False
    
        .Resize(, 6).FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=$D2=""120 Days"""
'        .FormatConditions(rng.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(6).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
        End With
         .FormatConditions(6).StopIfTrue = False
    
        .Resize(, 3).FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=$D2=""Immediate"""
'        .FormatConditions(rng.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(7).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
        End With
         .FormatConditions(7).StopIfTrue = False
    
    End With
    sel.Select
    cel.Activate
End Sub

Open in new window

0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 34971557
Hmm, intersting and pretty much as expected from Patricks comment ... in 2007 it is indeed critical on the selected cell.  The immediately preceding version of code to add multiple CF to the sheet is therefore what is wanted to avoid concerns with cursor placement - i.e. it will work in any version after and including 2007.

If this is the chosen method then please recall when awarding points his input.

Chris
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 35191230
Personally I would suggest http:#34969408 as the answer with a half split on http:#34968886

Chris
0
 
LVL 24

Expert Comment

by:broomee9
ID: 35356938
This question has been classified as abandoned and is being closed as part of the Cleanup Program. See my comment at the end of the question for more details.
0

Featured Post

On Demand Webinar - Networking for the Cloud Era

This webinar discusses:
-Common barriers companies experience when moving to the cloud
-How SD-WAN changes the way we look at networks
-Best practices customers should employ moving forward with cloud migration
-What happens behind the scenes of SteelConnect’s one-click button

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

688 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question