Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code stopped working
The first portion of my code has stopped working where the row range are colored based on the various scenarios. It was working before an now it just suddenly stopped. I have been changing and adding to m code. Can anyone tell me why my code is not working for the th coloring of cell row ranges? Thank for your help! Code ------------------- Private Sub Worksheet_Change(ByVal Target As Range) '----------------------------------------------------------------- Const WS_RANGE As String = "O:O" If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then With Target 'Begin coloring row ranges based on these requirements If .Row 3 Then If Me.Cells(.Row, "O").Value = "" Or Me.Cells(.Row, "O").Value = "O" Or Me.Cells(.Row, "O").Value = "H" Then Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 0 End If If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "P").Value = "DR" Then Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 39 End If If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "P").Value = "HJB" Then Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 6 End If If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "P").Value = "DLH" Then Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 7 End If If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "P").Value = "FDC" Then Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 4 End If If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "P").Value = "CJ" Then Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 45 End If If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "P").Value = "RT" Then Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 20 End If If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "P").Value = "GRR" Then Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 22 End If If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "P").Value = "TRG" Then Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 54 End If If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "P").Value = "GP" Then Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 50 End If If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "P").Value = "DC" Then Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 40 End If If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "P").Value = "JOINT" Then Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 15 End If 'Clear Std Hours If Me.Cells(.Row, "O") = "C" Then Me.Cells(.Row, "R").ClearContents End If 'Placing "1's" in columns based on these requirments. If Me.Cells(.Row, "O").Value = "O" And Me.Cells(.Row, "M").Value = "PROD" Then Me.Cells(.Row, "AS").Value = 1 Else Me.Cells(.Row, "AS").ClearContents End If If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "M").Value = "PROD" Then Me.Cells(.Row, "AT").Value = 1 Else Me.Cells(.Row, "AT").ClearContents End If If Not Me.Cells(.Row, "O").Value = "O" And Not Me.Cells(.Row, "M").Value = "PROD" Then Me.Cells(.Row, "AW").Value = 1 Else Me.Cells(.Row, "AW").ClearContents End If If Not Me.Cells(.Row, "O").Value = "C" And Not Me.Cells(.Row, "M").Value = "PROD" Then Me.Cells(.Row, "AX").Value = 1 Else Me.Cells(.Row, "AX").ClearContents End If If Me.Cells(.Row, "P").Value = "NO ACTION" Then Me.Cells(.Row, "O").ClearContents Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 48 End If If Me.Cells(.Row, "O").Value = "H" And Me.Cells(.Row, "A").Value = "" Then Me.Cells(.Row, "A").Value = Date + 30 End If If Me.Cells(.Row, "O").Value = "O" And Me.Cells(.Row, "A").Value = "" Then Me.Cells(.Row, "A").Value = Me.Cells(.Row, "C") End If End If End With End If 'Force upper case on text in columns O and P If Target.Cells.Count 1 Or Target.HasFormula Then Exit Sub On Error Resume Next If Not Intersect(Target, Range("O:O")) Is Nothing Then Application.EnableEvents = False Target = UCase(Target) Application.EnableEvents = True End If On Error GoTo 0 If Target.Cells.Count 1 Or Target.HasFormula Then Exit Sub On Error Resume Next If Not Intersect(Target, Range("P:P")) Is Nothing Then Application.EnableEvents = False Target = UCase(Target) Application.EnableEvents = True End If On Error GoTo 0 End Sub -------------------- -- chris46521 ------------------------------------------------------------------------ chris46521's Profile: http://www.excelforum.com/member.php...o&userid=35909 View this thread: http://www.excelforum.com/showthread...hreadid=569613 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code stopped working
Are events enabled?
Enter Application.EnableEvents = True in the immediate window in the VBIDE. -- HTH Bob Phillips (replace somewhere in email address with gmail if mailing direct) "chris46521" wrote in message ... The first portion of my code has stopped working where the row ranges are colored based on the various scenarios. It was working before and now it just suddenly stopped. I have been changing and adding to my code. Can anyone tell me why my code is not working for the the coloring of cell row ranges? Thank for your help! Code: -------------------- Private Sub Worksheet_Change(ByVal Target As Range) '----------------------------------------------------------------- Const WS_RANGE As String = "O:O" If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then With Target 'Begin coloring row ranges based on these requirements If .Row 3 Then If Me.Cells(.Row, "O").Value = "" Or Me.Cells(.Row, "O").Value = "O" Or Me.Cells(.Row, "O").Value = "H" Then Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 0 End If If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "P").Value = "DR" Then Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 39 End If If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "P").Value = "HJB" Then Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 6 End If If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "P").Value = "DLH" Then Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 7 End If If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "P").Value = "FDC" Then Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 4 End If If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "P").Value = "CJ" Then Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 45 End If If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "P").Value = "RT" Then Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 20 End If If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "P").Value = "GRR" Then Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 22 End If If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "P").Value = "TRG" Then Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 54 End If If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "P").Value = "GP" Then Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 50 End If If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "P").Value = "DC" Then Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 40 End If If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "P").Value = "JOINT" Then Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 15 End If 'Clear Std Hours If Me.Cells(.Row, "O") = "C" Then Me.Cells(.Row, "R").ClearContents End If 'Placing "1's" in columns based on these requirments. If Me.Cells(.Row, "O").Value = "O" And Me.Cells(.Row, "M").Value = "PROD" Then Me.Cells(.Row, "AS").Value = 1 Else Me.Cells(.Row, "AS").ClearContents End If If Me.Cells(.Row, "O").Value = "C" And Me.Cells(.Row, "M").Value = "PROD" Then Me.Cells(.Row, "AT").Value = 1 Else Me.Cells(.Row, "AT").ClearContents End If If Not Me.Cells(.Row, "O").Value = "O" And Not Me.Cells(.Row, "M").Value = "PROD" Then Me.Cells(.Row, "AW").Value = 1 Else Me.Cells(.Row, "AW").ClearContents End If If Not Me.Cells(.Row, "O").Value = "C" And Not Me.Cells(.Row, "M").Value = "PROD" Then Me.Cells(.Row, "AX").Value = 1 Else Me.Cells(.Row, "AX").ClearContents End If If Me.Cells(.Row, "P").Value = "NO ACTION" Then Me.Cells(.Row, "O").ClearContents Me.Cells(.Row, "A").Resize(, 26).Interior.ColorIndex = 48 End If If Me.Cells(.Row, "O").Value = "H" And Me.Cells(.Row, "A").Value = "" Then Me.Cells(.Row, "A").Value = Date + 30 End If If Me.Cells(.Row, "O").Value = "O" And Me.Cells(.Row, "A").Value = "" Then Me.Cells(.Row, "A").Value = Me.Cells(.Row, "C") End If End If End With End If 'Force upper case on text in columns O and P If Target.Cells.Count 1 Or Target.HasFormula Then Exit Sub On Error Resume Next If Not Intersect(Target, Range("O:O")) Is Nothing Then Application.EnableEvents = False Target = UCase(Target) Application.EnableEvents = True End If On Error GoTo 0 If Target.Cells.Count 1 Or Target.HasFormula Then Exit Sub On Error Resume Next If Not Intersect(Target, Range("P:P")) Is Nothing Then Application.EnableEvents = False Target = UCase(Target) Application.EnableEvents = True End If On Error GoTo 0 End Sub -------------------- -- chris46521 ------------------------------------------------------------------------ chris46521's Profile: http://www.excelforum.com/member.php...o&userid=35909 View this thread: http://www.excelforum.com/showthread...hreadid=569613 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Code stopped working
Thanks Bob! -- chris46521 ------------------------------------------------------------------------ chris46521's Profile: http://www.excelforum.com/member.php...o&userid=35909 View this thread: http://www.excelforum.com/showthread...hreadid=569613 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Can someone please tell me why my code stopped working??? | Excel Worksheet Functions | |||
VB Stopped Working | Excel Worksheet Functions | |||
excel 97 stopped working | Excel Worksheet Functions | |||
ADO Connection stopped working | Excel Programming | |||
Tab stopped working | Excel Programming |