Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Adding Colour
Hi, I'm looking to add colour to a row selection when a certain criteria is met. There is more than three criteria so the below Conditional formatting won't work on the test table also attached. Order customer source £ 4 bill a 6 4 bill d 5 5 bill a 7 5 bill b 4 5 bill c 3 Selection.FormatConditions.Delete Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _ "=IF($C1=""a"",TRUE,FALSE)" Selection.FormatConditions(1).Interior.ColorIndex = 36 Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _ "=IF($C1=""b"",TRUE,FALSE)" Selection.FormatConditions(2).Interior.ColorIndex = 35 Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _ "=IF($C1=""f"",TRUE,FALSE)" Selection.FormatConditions(3).Interior.ColorIndex = 40 So I've tried using a If and Do statement but I'm having trouble with it. Can anyone point me in the right direction Sub Add_Colour() Range("C2").Select Application.ScreenUpdating = False Do If ActiveCell = "a" Then Call SelectActiveRow With Selection ..ColorIndex = 36 End With End If If ActiveCell = "b" Then Call SelectActiveRow End With Selection ..ColorIndex = 35 End With End If If ActiveCell = "c" Then Call SelectActiveRow With Selection ..ColorIndex = 34 End With End If If ActiveCell = "d" Then Call SelectActiveRow With Selection ..ColorIndex = 37 End With End If ActiveCell.Offset(1, 0).Range("A1").Select Loop Until IsEmpty(ActiveCell.Offset(0, 1)) Application.ScreenUpdating = True End Sub Sub SelectActiveRow() If IsEmpty(ActiveCell) Then Exit Sub ' ignore error if activecell is in Column A On Error Resume Next If IsEmpty(ActiveCell.Offset(0, -1)) Then Set LeftCell = ActiveCell Else Set LeftCell = ActiveCell.End(xlToLeft) If IsEmpty(ActiveCell.Offset(0, 1)) Then Set RightCell = ActiveCell Else Set RightCell = ActiveCell.End(xlToRight) Range(LeftCell, RightCell).Select End Sub Thanks in advance VBA Noob -- VBA Noob ------------------------------------------------------------------------ VBA Noob's Profile: http://www.excelforum.com/member.php...o&userid=33833 View this thread: http://www.excelforum.com/showthread...hreadid=536110 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Adding Colour
If I interpretted your code correctly this should work Sub Add_Colour( Range("A2").Selec Application.ScreenUpdating = Fals D ActiveCell.Offset(0, 2).Activat If ActiveCell = "a" Then myColor = 3 If ActiveCell = "b" Then myColor = 3 If ActiveCell = "c" Then myColor = 3 If ActiveCell = "d" Then myColor = 3 If ActiveCell < "a" And ActiveCell < "b" And ActiveCell < "c" An ActiveCell < "d" The MsgBox "The ActiveCell does not equal any of the choices. Exit Su End I If IsEmpty(ActiveCell) Then Exit Su ' ignore error if activecell is in Column On Error Resume Nex If IsEmpty(ActiveCell.Offset(0, -1)) Then Set LeftCell = ActiveCel Else Set LeftCell = ActiveCell.End(xlToLeft If IsEmpty(ActiveCell.Offset(0, 1)) Then Set RightCell = ActiveCel Else Set RightCell = ActiveCell.End(xlToRight Range(LeftCell, RightCell).Selec With Selection.Interio .ColorIndex = myColo End Wit ActiveCell.Offset(1, 0).Range("A1").Selec Loop Until IsEmpty(ActiveCell Application.ScreenUpdating = Tru End Su Hope that's what you needed -Ikaabo -- Ikaabo ----------------------------------------------------------------------- Ikaabod's Profile: http://www.excelforum.com/member.php...fo&userid=3337 View this thread: http://www.excelforum.com/showthread.php?threadid=53611 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Adding Colour
Thanks Ikaabod. That worked. Also got another solution now Sub FillColors() Dim c As Range For Each c In Range("C1:C" & Cells(Rows.Count, 3).End(xlUp).Row) Select Case c Case "a" Range(c.Offset(0, -2), c.End(xlToRight)).Interior.ColorIndex = 36 Case "b" Range(c.Offset(0, -2), c.End(xlToRight)).Interior.ColorIndex = 35 Case "c" Range(c.Offset(0, -2), c.End(xlToRight)).Interior.ColorIndex = 34 Case "d" Range(c.Offset(0, -2), c.End(xlToRight)).Interior.ColorIndex = 37 Case "e" Range(c.Offset(0, -2), c.End(xlToRight)).Interior.ColorIndex = 27 Case "f" Range(c.Offset(0, -2), c.End(xlToRight)).Interior.ColorIndex = 40 Case "g" Range(c.Offset(0, -2), c.End(xlToRight)).Interior.ColorIndex = 24 Case "h" Range(c.Offset(0, -2), c.End(xlToRight)).Interior.ColorIndex = 46 End Select Next c End Sub Danny -- VBA Noob ------------------------------------------------------------------------ VBA Noob's Profile: http://www.excelforum.com/member.php...o&userid=33833 View this thread: http://www.excelforum.com/showthread...hreadid=536110 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Adding by font colour in Excel | Excel Worksheet Functions | |||
Adding figures of only one colour | Excel Discussion (Misc queries) | |||
Adding colour in a formula | Excel Discussion (Misc queries) | |||
Adding colour to result in a cell? | Excel Discussion (Misc queries) | |||
Adding colour background to control | Excel Programming |