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
This method (took a while to set up) and had a limit on the number of columns I could reference. I've just found another solution to allow the range of columns to be extended beyond that limitation:
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
I'd like to thank you for taking the time and effort to help me with this!
Best regards.
|