PDA

View Full Version : VBA for MORE Conditional Formating Excel 2003



klutz
07-01-2009, 07:38 PM
Hello Friends....:help
I have a worksheet in which one column (B) I have named countries using a vertical look up formula and in column C i have a dollar figure also with a lookup formula that comes from the country looked up in column B......What I want is a conditional format turning the interior cell of COLumn C to turn GREEN whenever a specific country is in column B. In excell 2003 I only have 3 allowances. I need at least 15.

So, if in column B i have Germany, I want Column C to turn green because Germany is in Column B...

:bug: Not sure If I explain this clearly enough..:dunno

xld
07-01-2009, 11:43 PM
'-----------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
'-----------------------------------------------------------------
Const WS_RANGE As String = "B:B" '<=== change to suit
Dim iCol As Long

On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then

With Target

Select Case .Value

Case "Germany": iCol = 10 'green
Case "France": iCol = 6 'yellow
Case "Italy": iCol = 5 'blue
Case "UK": iCol = 3 'red
'etc
End Select
.Offset(0, 1).Interior.ColorIndex = iCol
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub


This is worksheet event code, which means that it needs to be
placed in the appropriate worksheet code module, not a standard
code module. To do this, right-click on the sheet tab, select
the View Code option from the menu, and paste the code in.

klutz
07-02-2009, 07:27 AM
Wow, great, thank you my friend. It works wonderful. I was :banghead: last night trying to figure it out. I'm grateful.:friends: HAve a great day from all of us here in the Tropical Island with many many miles of sandy beaches and clear blue warm waters.....:thumb

xld
07-02-2009, 08:14 AM
Which tropicall island? I would be jealous but I suffer in the heat :)

klutz
07-02-2009, 11:48 AM
Which tropicall island? I would be jealous but I suffer in the heat :)

Puerto Rico...The Shinning Star of the Caribbean. It's close to about 95 in San Juan, but I am in an A/C office so it is KOOL....

:dunno OK. The code works great BUT i forgot to mentioned another condition which i needed. The condition I have now which you greatly helped is changing column C cell to a color based on the given condition of column B, which is great and it works fine. The other condition i need is that the conditions on column B when it is met can change the color of the cell on column G...

Example: This is what it is doing right now: Colomn "B" row 4 cell has Germany, it changes color on column "C" row4 cell to green.

Colomn "B" row 5 cell has "Italy", I need it to change color on column "G" row 5 cell to blue and not colum C row 4 to green.

I offset the colomn son the ---.Offset(0, 3).Interior.ColorIndex = iCol---
but it changes the first condition.:thumb

xld
07-02-2009, 11:59 AM
'-----------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
'-----------------------------------------------------------------
Const WS_RANGE As String = "B:B" '<=== change to suit
Dim iCol As Long, iCI As Long

On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then

With Target

Select Case .Value

Case "Germany": iCol = 1: iCI = 10 'green
Case "France": iCol = 2: iCI = 6 'yellow
Case "Italy": iCol = 5: iCI = 5 'blue
Case "UK": iCol = 4: iCI = 3 'red
'etc
End Select
.Offset(0, iCol).Interior.ColorIndex = iCI
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

lucas
07-02-2009, 12:05 PM
Probably not the best but it seems to work:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'-----------------------------------------------------------------
Const WS_RANGE As String = "B:B" '<=== change to suit
Dim iCol As Long

On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then

With Target

If Target.Value = "Germany" Then .Offset(0, 1).Interior.ColorIndex = 10
If Target.Value = "France" Then .Offset(0, 1).Interior.ColorIndex = 6
If Target.Value = "Italy" Then .Offset(0, 5).Interior.ColorIndex = 5
If Target.Value = "UK" Then .Offset(0, 1).Interior.ColorIndex = 3
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

klutz
07-02-2009, 12:15 PM
Mr. XLD,

Is it possible to also change the color of data on column B to match those colors of column C and G. I just though of that now. since the user will be alerted of the colors they can see it form the beginning, the COUNTRY NAME.

Thanks Friend

xld
07-02-2009, 12:19 PM
'-----------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
'-----------------------------------------------------------------
Const WS_RANGE As String = "B:B" '<=== change to suit
Dim iCol As Long, iCI As Long

On Error Goto ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then

With Target

Select Case .Value

Case "Germany": iCol = 1: iCI = 10 'green
Case "France": iCol = 2: iCI = 6 'yellow
Case "Italy": iCol = 5: iCI = 5 'blue
Case "UK": iCol = 4: iCI = 3 'red
'etc
End Select
.Offset(0, iCol).Interior.ColorIndex = iCI
.Interior.ColorIndex = iCI
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

klutz
07-02-2009, 02:07 PM
Hi Fellas, something is not working. the cells do not change color unless I manually enter the data. Right now the data is being fed into the columns and rows via a formula. Unless i enter the data manually the conditional format is not triggered. Is there anyway around this? I'm sorry to keeo bothering everyone,,,,

klutz
07-02-2009, 02:21 PM
Fellas, this is what i had, but it only changed the colors on the range that I specified. It works even though the cells have formulas in them. The only Thing I do is refresh the cells so that the colors appears... Can this be changed to to included the changes in other columns as with the vba code that you had provided earlier?...Thanks again


'Conditional Formats, Looking for Friendly Fronts on Premium Collections Worksheet
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim icolor As Integer
If Not Intersect(Target, Range("e24:g176")) Is Nothing Then
Select Case Target
Case "Dom. Republic": icolor = 4
Case "Bolivia": icolor = 4
Case "Paraguay": icolor = 4
Case "Peru" To "Peru": icolor = 4
Case "Costa Rica": icolor = 4
Case "Nicaragua": icolor = 4
Case "Panama": icolor = 4

'Tarrif rated countries must be pre-approved or approved by superintendency
Case "Bangladesh": icolor = 6
Case "Belarus": icolor = 6
Case "Belgium": icolor = 6
Case "Brazil": icolor = 6
Case "Brunei": icolor = 6
Case "China": icolor = 6
Case "Dom. Republic": icolor = 6
'Tarrif rated countries Guatemala must be approved by superintendency
Case "Guatemala": icolor = 3
Case "Spain": icolor = 14
Case "Uganda": icolor = 6
Case "Virgin Islands US": icolor = 6

Case Else
icolor = 20
End Select
Target.Interior.ColorIndex = icolor
End If
End Sub

xld
07-02-2009, 03:07 PM
Is this what you mean?



'Conditional Formats, Looking for Friendly Fronts on Premium Collections Worksheet
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim iColor As Long
Dim iColumn As Long
If Not Intersect(Target, Range("e24:g176")) Is Nothing Then
Select Case Target
Case "Dom. Republic", "Bolivia", "Paraguay", "Peru", "Costa Rica", "Nicaragua", "Panama"
iColor = 4
iColumn = 5

'Tarrif rated countries must be pre-approved or approved by superintendency
Case "Bangladesh", "Belarus", "Belgium", "Brazil", "Brunei", "China", "Dom. Republic"
iColor = 6
iColumn = 1

'Tarrif rated countries Guatemala must be approved by superintendency
Case "Guatemala"
iColor = 3
iColumn = 1

Case "Spain"
iColor = 14
iColumn = 7

Case "Uganda"
iColor = 6
iColumn = 5

Case "Virgin Islands US"
iColor = 6
iColumn = 3

Case Else
iColor = 20
iColumn = 78

End Select
Target.Offset(0, iColumn).Interior.ColorIndex = iColor
Target.Interior.ColorIndex = iColor
End If
End Sub

klutz
07-02-2009, 05:53 PM
XLD,

I had something similar to this, it work but only half way, so it was not really good. Yours by BTW works perfectly.

Question, the original (I think) allowed for the colors to reset themelves back to its original color whenever the condition was changed to a country not on the "Conditional Formatted" list.

Example: China is a condition that happens to fall in cell G5, it changes cell color to Yellow (column g) and also column K (K5) . Now when China is not selected and on that same cell and lets say Trinidad is selected, the G column
reverts back to original color but column K5 stays green, I have to change it manually to a no-fill color.

Could there be a way around this?.

Gracias....

xld
07-03-2009, 12:58 AM
The difficult klutz is in knowing what was in that cell before, that it was China. There would be no problem removing the colour in the whole line, but identifying particular cells would be tricky(ish).

klutz
07-03-2009, 10:06 PM
XLD, I received a Run Type 13 Type Mismatch Error on the code at this specific line:

Case "Dom. Republic", "Bolivia", "Paraguay", "Peru", "Costa Rica", "Nicaragua", "Panama"
iColor = 4
iColumn = 5

It only happens when I select or high the complete row or 2 or more cells within the column where the range is :

If Not Intersect(Target, Range("e24:g176")) Is Nothing Then

What could be happening? Thanks again...

klutz
07-03-2009, 10:10 PM
Oh Man, here I go again....Is there a way to be able to select 2 or more columns to be formatted for the same target case:

Example-

Case "Ireland" , "Sweden:
iColor = 4
iColumn = 5 and another column like column 10 and 15 ?
pray2: " pray2: "

Thanks...

klutz
07-03-2009, 10:11 PM
:(

xld
07-04-2009, 03:10 AM
XLD, I received a Run Type 13 Type Mismatch Error on the code at this specific line:

Case "Dom. Republic", "Bolivia", "Paraguay", "Peru", "Costa Rica", "Nicaragua", "Panama"
iColor = 4
iColumn = 5

It only happens when I select or high the complete row or 2 or more cells within the column where the range is :

If Not Intersect(Target, Range("e24:g176")) Is Nothing Then

What could be happening? Thanks again...



'Conditional Formats, Looking for Friendly Fronts on Premium Collections Worksheet
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim iColor As Long
Dim iColumn As Long
Dim cell As Range

If Not Intersect(Target, Range("e24:g176")) Is Nothing Then

For Each cell In Target

If cell.Value <> "" Then

Select Case Target
Case "Dom. Republic", "Bolivia", "Paraguay", "Peru", "Costa Rica", "Nicaragua", "Panama"
iColor = 4
iColumn = 5

'Tarrif rated countries must be pre-approved or approved by superintendency
Case "Bangladesh", "Belarus", "Belgium", "Brazil", "Brunei", "China", "Dom. Republic"
iColor = 6
iColumn = 1

'Tarrif rated countries Guatemala must be approved by superintendency
Case "Guatemala"
iColor = 3
iColumn = 1

Case "Spain"
iColor = 14
iColumn = 7

Case "Uganda"
iColor = 6
iColumn = 5

Case "Virgin Islands US"
iColor = 6
iColumn = 3

Case Else
iColor = 20
iColumn = 78

End Select
Target.Offset(0, iColumn).Interior.ColorIndex = iColor
Target.Interior.ColorIndex = iColor
End If
Next cell
End If
End Sub

klutz
07-04-2009, 03:21 PM
Thanks XID, but the run time error 13 type mismatch remains, . The code points to :

Case "Dom. Republic", "Bolivia", "Paraguay", "Peru", "Costa Rica", "Nicaragua", "Panama"
iColor = 4
iColumn = 5

Also, how can I make it to format 2 or more columns with colors whenever the condition is met?

Thanx.

The Klutz...:help

mdmackillop
07-04-2009, 03:26 PM
Try
Select Case Target.value

mdmackillop
07-04-2009, 03:31 PM
On a second look try

'Conditional Formats, Looking for Friendly Fronts on Premium Collections Worksheet
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim iColor As Long
Dim iColumn As Long
Dim cell As Range

If Not Intersect(Target, Range("e24:g176")) Is Nothing Then

For Each cell In Target

If cell.Value <> "" Then

Select Case cell.Value
Case "Dom. Republic", "Bolivia", "Paraguay", "Peru", "Costa Rica", "Nicaragua", "Panama"
iColor = 4
iColumn = 5

'Tarrif rated countries must be pre-approved or approved by superintendency
Case "Bangladesh", "Belarus", "Belgium", "Brazil", "Brunei", "China", "Dom. Republic"
iColor = 6
iColumn = 1

'Tarrif rated countries Guatemala must be approved by superintendency
Case "Guatemala"
iColor = 3
iColumn = 1

Case "Spain"
iColor = 14
iColumn = 7

Case "Uganda"
iColor = 6
iColumn = 5

Case "Virgin Islands US"
iColor = 6
iColumn = 3

Case Else
iColor = 20
iColumn = 78

End Select
cell.Offset(0, iColumn).Interior.ColorIndex = iColor
cell.Interior.ColorIndex = iColor
End If
Next cell
End If
End Sub

klutz
07-04-2009, 05:14 PM
I'm no longer having the type mismatch but I do have these problems with the lates VBA Codes.


Problems
1. The colors wont fill in column G unless I click on the cell in the column G individually.
2. I click on the cells inividually and the columns G, I & K will format with the colors needed.
3. If I select 2 or 3 cells in column G the cells will change to the color of the first cell I select
4. If I select the complete column all the cells will change to each different color in the macro code
5. if I change the country to one that is not formatted for a color and place it in a cell that previously had a color coded country that particular cell wont change color unless I select the cell manually
6. If I selected a country that was color coded and later I decide to delete it the cell will remain with its previous formatte color


Any thoughts?...Thanx...


'Conditional Formats, Looking for Friendly Fronts on Premium Collections Worksheet
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim iColor As Long
Dim iColumn As Long
Dim cell As Range

If Not Intersect(Target, Range("e24:g176")) Is Nothing Then

For Each cell In Target

If cell.Value <> "" Then

Select Case cell.Value
Case "Dom. Republic", "Bolivia", "Paraguay", "Peru", "Costa Rica", "Nicaragua", "Panama"
iColor = 4
iColumn = 4

'Tarrif rated countries must be pre-approved or approved by superintendency
Case "Bangladesh", "Belarus", "Belgium", "Brazil", "Brunei", "China"
iColor = 6
iColumn = 2

'Tarrif rated countries Guatemala must be approved by superintendency
Case "Guatemala"
iColor = 3
iColumn = 2

Case "Spain"
iColor = 14
iColumn = 2

Case "Uganda"
iColor = 6
iColumn = 2

Case "Virgin Islands US"
iColor = 6
iColumn = 2


Case Else
iColor = 0
iColumn = 4


End Select
Target.Offset(0, iColumn).Interior.ColorIndex = iColor
Target.Interior.ColorIndex = iColor
End If
Next cell
End If
End Sub

mdmackillop
07-05-2009, 01:15 AM
Sorry, I edited just after posting so the Target lines were incorrect.
I'm not fully clear on your other issues, but try this version.

klutz
07-05-2009, 10:52 AM
Sorry, I edited just after posting so the Target lines were incorrect.
I'm not fully clear on your other issues, but try this version.

Wow, kool...it works fantastically.

One other thing, How can the code be changed to format more than one column for each condition met? For example.

This piece of code only lets me format column 2. I also wish to format column 5 with the same color, how is this accomplished?

'Tarrif rated countries must be pre-approved or approved by superintendency
Case "Bangladesh", "Belarus", "Belgium", "Brazil", "Brunei", "China"
iColor = 6
iColumn = 2

Thanx once again...

xld
07-05-2009, 10:59 AM
Add another column variable, set that in each case statement, and then add another set of statements after the end select.

klutz
07-05-2009, 11:30 AM
Add another column variable, set that in each case statement, an d then add another set of statements after the end select.

Thanx, I kinda did that but it did not add the color to the second column. Not sure if id did it correctly.


I needd to format color for column 5 for these countries with the same color.

Thanx again...:banghead:

Case "Bangladesh", "Belarus", "Belgium", "Brazil", "Brunei", "China"
iColor = 6
iColumn = 2


Here is the code--

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
If Target.Columns.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("c24:c176")) Is Nothing Then
For Each cell In Target
If cell.Value <> "" Then
MakeChange cell.Offset(, 4)
Else
cell.EntireRow.Interior.ColorIndex = xlNone
End If
Next cell
End If

End Sub

'Conditional Formats, Looking for Friendly Fronts on Premium Collections Worksheet
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim cell As Range
If Target.Columns.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("e24:g176")) Is Nothing Then
For Each cell In Target
If cell.Value <> "" Then MakeChange cell
Next cell
End If
End Sub

Sub MakeChange(cell As Range)
Dim iColor As Long
Dim iColumn As Long

Select Case cell.Value
Case "Dom. Republic", "Bolivia", "Paraguay", "Peru", "Costa Rica", "Nicaragua", "Panama"
iColor = 4
iColumn = 4

'Tarrif rated countries must be pre-approved or approved by superintendency
Case "Bangladesh", "Belarus", "Belgium", "Brazil", "Brunei", "China"
iColor = 6
iColumn = 2


'Tarrif rated countries Guatemala must be approved by superintendency
Case "Guatemala", "Guatemala"
iColor = 3
iColumn = 5


Case "Spain"
iColor = 14
iColumn = 2

Case "Uganda"
iColor = 6
iColumn = 2

Case "Virgin Islands US"
iColor = 6
iColumn = 2


Case Else
iColor = 0
iColumn = 0


End Select
cell.Resize(, 1).Interior.ColorIndex = xlNone
cell.Offset(0, iColumn).Interior.ColorIndex = iColor
cell.Interior.ColorIndex = iColor




End Sub

mdmackillop
07-05-2009, 01:22 PM
Like

Case "Guatemala", "Guatemala"
iColor = 3
iColumn = 5
jColumn = 10

'and
cell.Offset(0, iColumn).Interior.ColorIndex = iColor
cell.Offset(0, jColumn).Interior.ColorIndex = iColor

klutz
07-05-2009, 03:19 PM
Like

Case "Guatemala", "Guatemala"
iColor = 3
iColumn = 5
jColumn = 10

'and
cell.Offset(0, iColumn).Interior.ColorIndex = iColor
cell.Offset(0, jColumn).Interior.ColorIndex = iColor



OK hermanos..It is just what I need. Grateful to all the knowledgeable folks that helped me out :bow: "El XID and Mdmackillop" :bow: and this very kool :thumb forum.

I knew just a little bit yesterday, today I know a little bit more and 2morrow, well I;ll wait for 2morrow....i'll be learning even more..

Thanx ....:beerchug: