|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
VBA to immediately change the colour of a cell depending on the code placed in anothe
Hello,
Firstly please let me advise that standard conditional formatting will not work here as this requires ten conditions to be set. I have a worksheet that contains 40 'paired' columns. In the first column of each pair I can enter any one of ten condition codes. The corresponding cell in the second of the paired columns needs to change its interior colour to that dictated by the code in the first of the pair. I have tried a few ways without success with my last attempt almost making it where I used three named ranges and this code: Code:
Dim conditions() ReDim conditions(1 To Range("conditions2use").Count) Dim i i = 1 For Each cell In Range("conditions2use") conditions(i) = CInt(cell.Value) i = i + 1 Next cell i = 1 For Each cell In Range("data2use") Range("formats2use").Cells(conditions(i)).Select Selection.Copy cell.Select Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False i = i + 1 Next cell I hope someone in this forum has had a similar requirement in the past and can provide a solution. I am using MS Excel 2003 SR3. Thanks in anticipation |
#2
|
||||
|
||||
Hi, Phil. I came here more than a month later to ask a question myself, and thought I'd look over some of these. I'm sorry no one has offered you what seems to me an obvious solution: Have you tried using a macro that runs automatically whenever any value on that worksheet has changed?
In general, VBA programs that are triggered by events in Office apps are named <Object-name>_<Eventname>, for example "Button1_Click" or "Form_Open". In this case you want, I think, "Worksheet_Change", like this: Private Sub Worksheet_Change(ByVal ChangedCell As Range) MsgBox "You put a new value in some cell on row " & ChangedCell.Row & "." End Sub You must include the specified parm as listed above, though you can name it whatever you like. You put this code not in a regular code module but in the code for the related worksheet. After that, whenever you enter a value on that worksheet, Excel will set your argument to the the cell object that was changed, and run the program. In this case you want your program to check the address of the changed cell. If it's not column A then just Exit Sub without comment, and the user will never be bothered with it. Otherwise set the adjacent cell based on the new value in the changed cell. Clear? Whenever I test this, I discover some pesky reason why the macro won't fire, and it's always some reason I forgot about since the last time I did this kind of thing. (I don't have to do it very often, so I forget each time.) Let me know if you have trouble of that kind, and I'll try to find an article listing some of the obvious reasons. Just now it turned out Application.EnableEvents was set to False for some reason; I just turned it back on and it worked great. |
#3
|
|||
|
|||
Hello Bob,
I did find a solution for this, but as soon as I did the requirement changed and I haven't had time to return and post the solution. The solution was as you said, by use of an 'worksheet change' macro:- Code:
Private Sub Worksheet_Change(ByVal Target As Range) Dim rCell As Excel.Range Dim rCodes As Range Dim vMatch Set rCodes = Range("B2:B12") If Not Intersect(Target, Range("O:O,R:R,U:U,X:X,AA:AA,AD:AD,AG:AG,AJ:AJ,AM:AM,AP:AP,AS:AS,AV:AV,AY:AY,BB:BB,BE:BE,BH:BH,BK:BK,BN:BN,BO:BO,BT:BT,BW:BW,BZ :BZ,CC:CC,CF:CF,CI:CI,CL:CL,CO:CO,CR:CR,CU:CU,CX:CX,DA:DA,DD:DD,DG:DG,DJ:DJ,DM:DM,DP:DP,DS:DS,DV:DV,DY:DY,EB:EB")) Is Nothing Then For Each rCell In Intersect(Target, Range("O:O,R:R,U:U,X:X,AA:AA,AD:AD,AG:AG,AJ:AJ,AM:AM,AP:AP,AS:AS,AV:AV,AY:AY,BB:BB,BE:BE,BH:BH,BK:BK,BN:BN,BO:BO,BT:BT,BW:BW,BZ :BZ,CC:CC,CF:CF,CI:CI,CL:CL,CO:CO,CR:CR,CU:CU,CX:CX,DA:DA,DD:DD,DG:DG,DJ:DJ,DM:DM,DP:DP,DS:DS,DV:DV,DY:DY,EB:EB")).Cells If Len(rCell.Value) > 0 Then vMatch = Application.Match(rCell.Value, rCodes, 0) If IsError(vMatch) Then MsgBox "Invalid code selected" Else rCell.Offset(, 1).Interior.Color = rCodes.Cells(vMatch).Interior.Color End If End If Next rCell End If End Sub Code:
Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) ' This code checks for a change of Status in the Status column and ' on change fills the adjacent Cost cell with appropriate colour then ' enters current date into the adjacent Date cell. ' The range covered extends from column ‘R’ (first Status column), to column ‘EZ’ (last Status column). ' If adding columns adjust ranges accordingly! If Target.Count > 1 Then Exit Sub With Application .ScreenUpdating = False .EnableEvents = False End With Dim rCell As Range Dim rCodes As Range Dim rRow As Range Dim vMatch Set rCodes = Range("E2:E12") If (Target.Column >= 18) And (Target.Column <= Range("EZ1").Column) And (Target.Column Mod 3 = 0) Then If Len(Target.Value) > 0 Then On Error Resume Next vMatch = Application.Match(Target.Value, rCodes, 0) If IsError(vMatch) Then MsgBox "Invalid code selected" Else With Target .Offset(, 1).Interior.Color = rCodes.Cells(vMatch).Interior.Color .Offset(0, 2).Value = Date End With End If End If End If End Sub Best regards. |
Tags |
condition paste vba, formatting cells from vba |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Quadrant colour based on cell value | RoyLittle0 | Excel | 2 | 05-05-2013 12:50 AM |
Change font colour when tasks are completed | meileetan | Project | 3 | 09-12-2012 07:09 AM |
Change Colour Theme in Word with VBA | Davidoff78 | Word VBA | 1 | 06-28-2012 05:23 PM |
CHange colour of footer if a cell changes to red | OTPM | Excel | 0 | 05-26-2011 07:15 AM |
contacts email by colour code | mikemans | Outlook | 0 | 10-31-2009 01:47 AM |