Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 261
  • Last Modified:

Color Row on requirement

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
ExpertHelp79
Asked:
ExpertHelp79
  • 8
  • 5
  • 3
  • +3
2 Solutions
 
Ivo StoykovCommented:
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
 
Peter KwanCommented:
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
 
ExpertHelp79Author Commented:
ivostoykov:The macro is not working.. please test the same on the file i attached
0
Nothing ever in the clear!

This technical paper will help you implement VMware’s VM encryption as well as implement Veeam encryption which together will achieve the nothing ever in the clear goal. If a bad guy steals VMs, backups or traffic they get nothing.

 
ExpertHelp79Author Commented:
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
 
Ivo StoykovCommented:
work, if macros are enabled
see attached file

HTH

Ivo Stoykov Format.xlsm
0
 
ExpertHelp79Author Commented:
ivostoykov:macros are enabled at my end. And i am using the same file which you attached , its only coloring the first row
0
 
Peter KwanCommented:
Please try the attached.
Format.xlsm
0
 
Chris BottomleyCommented:
What version of excel?

Chris
0
 
ExpertHelp79Author Commented:
2007
0
 
Chris BottomleyCommented:
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
 
Patrick MatthewsCommented:
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
 
Chris BottomleyCommented:
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
 
Chris BottomleyCommented:
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
 
Patrick MatthewsCommented:
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
 
ExpertHelp79Author Commented:
chris_bottomley:Please give me sometime to test Thanks for the help
0
 
Chris BottomleyCommented:
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
 
Patrick MatthewsCommented:
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
 
Chris BottomleyCommented:
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
 
Chris BottomleyCommented:
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
 
Chris BottomleyCommented:
Personally I would suggest http:#34969408 as the answer with a half split on http:#34968886

Chris
0
 
TracyVBA DeveloperCommented:
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

Independent Software Vendors: 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!

  • 8
  • 5
  • 3
  • +3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now