Solved

Color Row on requirement

Posted on 2011-02-23
23
251 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
  • 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
 
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
What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

 
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

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
Entering a date in Microsoft Access can be tricky. A typo can cause month and day to be shuffled, entering the day only causes an error, as does entering, say, day 31 in June. This article shows how an inputmask supported by code can help the user a…
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

707 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

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now