More than 3 Conditional Formals - EXCEL 2000

[dazzag82]

I have a spreadsheet for Scheduling Projects and one of the columns is to
display the Project Status. Cells M21 to M120 are the cells which I would
like to apply conditioonal formatting to depending on the status of the
Project. Status is entered into the cell via a drop down menu (data
validation).

How do I write a piece of VBA code which willow me to format 7 conditions.

The formats I would like for each status type are as follows

Planned (no format required)
Pre Work (Pale Blue Background, Black Bold Font)
Workshop (Yellow Background, Black Bold Font)
Post Workshop (Light Orange Background, Black Bold Font)
Past Due (Red Background, White Bold Font)
Complete (Bright Green Background, Black Bold Font)
Cancelled (Tan Background, Red plainText )

If anyone can help with the general structure of the code that would be
great. I have seen some examples using the following types of code:

cell.Interior. ColorIndex = 37

or

Target.Interior.Color = RGB(255, 0, 255)

I have no clue what to do and I do not understand how to figure out what the
colourindex or RGB values are so any help on that would be great also.

I also have an issue where the majority of users will have excel 2000 but I
also need it to work in 2003 for one or two people.

Thanks for your help.

 

[Gord Dibben]

Status types in A1:A7

Numbers 37, 6, 45, 3, 4, 40 in B1:B7

Numbers 1, 1, 1, 2, 1, 3 in C1:C7

This event code in the sheet module.


Option Explicit
Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Vals As Range
Dim R As Range
Dim RR As Range
Set R = Range("M21:M120")
Set Vals = Range("A1:C7") 'adjust to suit lookup range
If Intersect(Target, R) Is Nothing Then Exit Sub
On Error Resume Next
For Each RR In Intersect(Target, R)
RR.Interior.ColorIndex = Application.VLookup(RR.Value, Vals, 2, False)
RR.Font.ColorIndex = Application.VLookup(RR.Value, Vals, 3, False)
If RR.Value = "cancelled" Then
RR.Font.Bold = False
Else
RR.Font.Bold = True
End If
Next RR
End Sub


Gord Dibben MS Excel MVP

 

[dazzag82]

Thanks Gord. Worked a treat!

Status types in A1:A7

Numbers 37, 6, 45, 3, 4, 40 in B1:B7

Numbers 1, 1, 1, 2, 1, 3 in C1:C7

This event code in the sheet module.


Option Explicit
Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Vals As Range
Dim R As Range
Dim RR As Range
Set R = Range("M21:M120")
Set Vals = Range("A1:C7") 'adjust to suit lookup range
If Intersect(Target, R) Is Nothing Then Exit Sub
On Error Resume Next
For Each RR In Intersect(Target, R)
RR.Interior.ColorIndex = Application.VLookup(RR.Value, Vals, 2, False)
RR.Font.ColorIndex = Application.VLookup(RR.Value, Vals, 3, False)
If RR.Value = "cancelled" Then
RR.Font.Bold = False
Else
RR.Font.Bold = True
End If
Next RR
End Sub


Gord Dibben MS Excel MVP




.

 

[dazzag82]

This has worked however I need one final piece of code which, if the status
is cleared to leave an emply cell, it will put the cell background to 'no
fill'.

If I select Complete from the drop down menu, the cell will change to green.
However if I clear the cell, it is blank but the background colour is still
green. I need it to revert back to no fill.

Is there anything I can add to the code you sent? Thanks.

 

[Gord Dibben]

If you hadn't already noticed there are a few things left out here.

Please make changes...........

Numbers -4142, 37, 6, 45, 3, 4, 40 in B1:B7

Numbers 1, 1, 1, 1, 2, 1, 3 in C1:C7

Option Explicit
Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Vals As Range
Dim R As Range
Dim RR As Range
Set R = Range("M21:M120")
Set Vals = Range("A1:C7") 'adjust to suit lookup range
If Intersect(Target, R) Is Nothing Then Exit Sub
On Error Resume Next
For Each RR In Intersect(Target, R)
RR.Font.ColorIndex = 1
RR.Interior.ColorIndex = Application.VLookup(RR.Value, Vals, 2, False)
RR.Font.ColorIndex = Application.VLookup(RR.Value, Vals, 3, False)
If RR.Value = "cancelled" Or RR.Value = "planned" Then
RR.Font.Bold = False
Else
RR.Font.Bold = True
End If
Next RR
End Sub


Gord

 

[Gord Dibben]

See my other post with ammendments and corrections.

One more corrections to code in this post.

Hope we have it all covered now.

Option Explicit
Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Vals As Range
Dim R As Range
Dim RR As Range
Set R = Range("M21:M120")
Set Vals = Range("A1:C7") 'adjust to suit lookup range
If Intersect(Target, R) Is Nothing Then Exit Sub
On Error Resume Next
For Each RR In Intersect(Target, R)
RR.Font.ColorIndex = 1
RR.Interior.ColorIndex = -4142
RR.Interior.ColorIndex = Application.VLookup(RR.Value, Vals, 2, False)
RR.Font.ColorIndex = Application.VLookup(RR.Value, Vals, 3, False)
If RR.Value = "cancelled" Or RR.Value = "planned" Then
RR.Font.Bold = False
Else
RR.Font.Bold = True
End If
Next RR
End Sub


Gord

 

[dazzag82]

Gord

This is it finally sorted. It is working perfectly. Thank You So Much.

 

[Gord Dibben]

Thanks for the feedback.

Gord

Gord

This is it finally sorted. It is working perfectly. Thank You So Much.

 

[dazzag82]

Hi Gord

I have another similar problem which i hope you can help with on the same
subject. As I have said the code you have supplied is working perfectly but I
need to apply the same conditional formatting in a different workbook in the
same column but in this case the status values are entered into the cell by
looking up values in other spreadsheets so it is not manual entry.

To explain fully we have 10 workbooks which are called 'locals', one for
each facility/factory to enter their own project data. Each of the 10
spreadsheets have the same formatting and layout. Each of these 10 workbooks
have the macro which you supplied to give me the conditional formatting in
column M for project status - all good so far.

We have an additional workbook called the 'master' which basically has a
command button macro that when pressed, it will consolodate all the data in
each of the 10 workbooks into the one worksheet in the master. Basically it
allows me to see the project plan at an overall business level so that
anytime I open the master and click the consolodate button, it will pull
across all the latest saved data in each of the local files. This macro
basically does the following:

Open Local Workbook 1
Select range of data and copy
Paste values into first blank row of master
Close Local Workbook 1
Open Local Workbook 2
Select range of data and copy
Paste values into master on next available blank row
Close Local Workbook 2
etc etc

I need to apply the same conditional formatting again in Column M for the
project status. Same colours and fonts as before. The issue is that your code
which is used in the locals does not work and I am wondering if it because
the data is enetered into the master using this consolodation macro and not a
drop down manual entry like the local. Do you know how to tweak your code so
that the 7 formats will work?

This maybe asking too much and maybe you don't have an answer for this
particular issue but you have been a great help so far and this would be the
final piece of the jigsaw I need to do to get this process 100% complete.

Darren

 

[Gord Dibben]

Does destination sheet in Master workbook have the worksheet event code and
the lookup table?

Copy/paste into column M should trigger the code.

Is the target range M21:M120 large enough to cover the pasted ranges from
the other workbooks?

Do you have anything in your consolidate macro that would disable events
application-wide?

I tested with a macro to open a workbook, copy a range containing the status
type keywords, switch to Master workbook destination sheet which has the
event code and lookup table, pasted to column M and all worked as
advertised.

Workbooks.Open Filename:= _
"C:\Program Files\Microsoft Office\Exceldata\Allskeds.xls"
Range("H1:H7").Select
Selection.Copy
Windows("Master.xls").Activate
Sheets("Sheet1").Select
Range("M21").Select
ActiveSheet.Paste
Windows("Allskeds.xls").Activate
ActiveWindow.Close

Please ignore all the "selects". Testing with recorder.

Gord

 

[dazzag82]

Thanks Gord

Got it working. I did have the look up table in place but I forgot to change
the worksheet event code to look uo a different cell range to find the table.
So easily done.

Thanks again.