PDA

View Full Version : color cell depending on input



Ger
01-07-2009, 07:02 AM
I'm using Excell 2003 Dutch version.

I have the following macro:
Public Sub kleur2()
For rij = 6 To 90
For kolom = 6 To 187
inkleuren2 rij, kolom
Next
Next
End Sub
Private Sub inkleuren2(r, c)
Dim CellValue As String
With Cells(r, c)
.Interior.ColorIndex = Kleurbepalen(.Value)
End With
End Sub

Private Function Kleurbepalen(kleurwaarde)
Select Case kleurwaarde
Case "WTV"
Kleurbepalen = 25
Case "CO"
Kleurbepalen = 13
Case "VL"
Kleurbepalen = 3

End Select
End Function

I must run this macro everytime things are changed.
I heard that it is possible to create a macro that changes the color of a cell directly when a value is entered.
I mean i type "WTV" in cell G6 and the background is color 25.
Can anyone help me?

abhiker
01-07-2009, 07:36 AM
maybe try putting your code inside of the following subroutine:



Private Sub Worksheet_SelectionChange(ByVal Target As Range)



End Sub

Ger
01-07-2009, 07:47 AM
It doesn't work. I think because of the first end sub in inkleuren2.

I heard the text must be put in the sheet or thisworkbook or something like that.

Ger

lucas
01-07-2009, 08:53 AM
This is not the best way to do this but it will work. See attached.

In a standard module:
Sub inkleuren2(r, c)
Dim CellValue As String
With Cells(r, c)
.Interior.ColorIndex = Kleurbepalen(.Value)
End With
End Sub
Function Kleurbepalen(kleurwaarde)
Select Case kleurwaarde
Case "WTV"
Kleurbepalen = 25
Case "CO"
Kleurbepalen = 13
Case "VL"
Kleurbepalen = 3
End Select
End Function


In the selection change event of the sheet:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
For rij = 6 To 90
For kolom = 6 To 187
inkleuren2 rij, kolom
Next
Next
End Sub

Ger
01-08-2009, 12:42 AM
Thanks,

this works fine.

Ger

Ger
01-08-2009, 07:44 AM
With the help of this forum I use the following macro

In a standard module:




VBA:
Sub inkleuren2(r, c) Dim CellValue As String With Cells(r, c) .Interior.ColorIndex = Kleurbepalen(.Value) End With End Sub Function Kleurbepalen(kleurwaarde) Select Case kleurwaarde Case "WTV" Kleurbepalen = 25 Case "CO" Kleurbepalen = 13 Case "VL" Kleurbepalen = 3 End Select End Function

VBA tags courtesy of www.thecodenet.com (http://www.thecodenet.com/)



In the selection change event of the sheet:




VBA:
Private Sub Worksheet_SelectionChange(ByVal Target As Range) For rij = 6 To 90 For kolom = 6 To 187 inkleuren2 rij, kolom Next Next End Sub

Here I already changed Worksheet_selectionChange In Worksheet_Change

But if I a change something out of the row 6 to 90 and column 6 to 187 the macro will start to work. How I can prevent that this happens

Ger

lucas
01-08-2009, 08:50 AM
Ger, this looks like it could be done much easier with native conditional formatting.

Select the range which appears to be row 6 to 90 and columns 6 to 187.

Then from the toolbar select Format and then select conditional formatting.

Drop the box on the left that says condition and select "cell value is"

In the next drop down select "equal to"

in the next box to the right type WTV

Then click the format button and select the actions you want to happen when WTV is typed into any of those cells.

now click the button that says add and you can add two more conditions to the range.

lucas
01-08-2009, 08:54 AM
Attached is a workbook with a range similar to yours marked to work with the strings you mention. The range is not the same as yours and the colors are not the ones you chose so you can look at this and adjust your own workbook once you understand how it works.

All versions before 2007 allow up to 3 conditions........

Ger
01-09-2009, 12:25 AM
i'm using excell 2003 dutch version. (excuses for my english)

with the help of this forum i'm using the following macro:
(in Module)
Sub inkleuren2(r, c)
Dim CellValue As String
With Cells(r, c)
.Interior.ColorIndex = Kleurbepalen(.Value)
End With
End Sub
Function Kleurbepalen(kleurwaarde)
kleurwaarde = UCase(kleurwaarde)
Select Case kleurwaarde
Case "WTV"
Kleurbepalen = 13
Case "CO"
Kleurbepalen = 10
Case "VL"
Kleurbepalen = 4
Case "VL NG"
Kleurbepalen = 45
Case "OT"
Kleurbepalen = 30
Case "MT"
Kleurbepalen = 30
Case "POC"
Kleurbepalen = 46
Case "OR"
Kleurbepalen = 46
Case "TWO"
Kleurbepalen = 26
End Select
End Function

And in the sheet:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
For rij = 6 To 90
For kolom = 6 To 187
inkleuren2 rij, kolom
Next
Next
End Sub

The problem where I run against is that there is data outside this range which can be mutated and the macro starts every time i want to make a change there. How can i prevent to start the macro outside the range row 6 to 90 and column 6 to 187?
Ger

Ger
01-09-2009, 12:40 AM
In my thread i just used 3 dynamics bur i need at least 8. So i tried with a macro. But you must "push the button" every time . So I tried the worksheet.change.
My problem is that there is data outside the range in the macro. So if i change this the macro will also start. How can i prevent this.


Ger

georgiboy
01-09-2009, 02:13 AM
What is the range where if changed the code should run?

georgiboy
01-09-2009, 02:24 AM
You could use this

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("F6:GE90")) Is Nothing Then

'Code goes here

End If

End Sub

Hope this helps

Bob Phillips
01-09-2009, 03:36 AM
Why are you checking all cells every time. Just check the cell being changed.

Ger
01-09-2009, 04:11 AM
How can i do that?

Ger

Ger
01-09-2009, 04:13 AM
see my thread from today

georgiboy
01-09-2009, 04:22 AM
I have i put something in there you may not have seen it.

Bob Phillips
01-09-2009, 05:10 AM
Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "E6:GE90"
Dim Kleurbepalen As Long

If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
Select Case UCase(Target.Value)
Case "WTV": Kleurbepalen = 13
Case "CO": Kleurbepalen = 10
Case "VL": Kleurbepalen = 4
Case "VL NG": Kleurbepalen = 45
Case "OT": Kleurbepalen = 30
Case "MT": Kleurbepalen = 30
Case "POC": Kleurbepalen = 46
Case "OR": Kleurbepalen = 46
Case "TWO": Kleurbepalen = 26
End Select

Target.Interior.ColorIndex = Kleurbepalen
End If

End Sub

Ger
01-09-2009, 05:37 AM
This works for a single input. But if i try to copy 2 or more cells within the range i get an error.

(Mistake 13) the cursor goes to Select Case UCase(Target.Value)

Ger
01-09-2009, 05:46 AM
I saw your answer, but the answer of XLD was very interesting because it works faster. So i'm trying that option. It works now for 1 cell. If it is not possible to copy more than 1 cell i'm gone use your sollution.

Thanks.

Ger

Bob Phillips
01-09-2009, 06:07 AM
Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "E6:GE90"
Dim cell As Range
Dim Kleurbepalen As Long

If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
For Each cell In Target
Select Case UCase(cell.Value)
Case "WTV": Kleurbepalen = 13
Case "CO": Kleurbepalen = 10
Case "VL": Kleurbepalen = 4
Case "VL NG": Kleurbepalen = 45
Case "OT": Kleurbepalen = 30
Case "MT": Kleurbepalen = 30
Case "POC": Kleurbepalen = 46
Case "OR": Kleurbepalen = 46
Case "TWO": Kleurbepalen = 26
End Select

cell.Interior.ColorIndex = Kleurbepalen
Next cell
End If

End Sub

Bob Phillips
01-09-2009, 06:07 AM
I have updated that post for multi-cells.

Ger
01-09-2009, 06:28 AM
Thanks, copying works but...
if a copied cell contains one of the names mentioned all cpoied cells get that color.
There are cells that contain numbers and other words. These cells may not be collored.

Ger

Ger
01-09-2009, 06:51 AM
Thanks.

Ger

Bob Phillips
01-09-2009, 06:59 AM
I am sorry, I am not getting your meaning here. What exactly are you doing?

Ger
01-09-2009, 07:10 AM
I attached a small example. The real sheet contains mutch more data.
lets say that aaa in row 21 "follows" the person in row 9 with 1 week delay. Instead of filling out each cell it must be possible to copy the data from row 21 (with 1 week delay) to row 9.
Most of the time there are changes in a single cell but it can happen that something must be copied from 1 person to another person.


Ger

lucas
01-09-2009, 07:20 AM
Threads merged

Ger, please don't start multiple threads on the same question.

Ger
01-09-2009, 07:34 AM
Lucas,

I marked this thread as solved because mij first problem was solved. I thougt that nobody would answer to a soved thread so i started a new one. But the people of this forum a very kind so in both my threads (open and solved) i get answers.

Thank you for putting them together. Is there a possibility to unsolve the thread??

Thanks,


Ger

lucas
01-09-2009, 07:46 AM
Solved removed from the title.

Ger please consider giving more details next time you start a thread. This could have been much shorter if we had known that your requirement was for more than 3 conditions......

ps. You can always ask followup questions in a thread marked solved. They show as having new posts and if we are subscribed to the thread we get notification that you have posted in the thread.......

Ger
01-16-2009, 01:06 AM
Since my threads where merged I didn't get any respons to my last problem.

Ger