Conditional Format with Date Stamp based on user input

[izet99]

Hi all,

I have issue with my vba code and I would really appreciate if somebody could help me to make it work. Basicly I have two vba code..

1. Auto-date stamp in column "K" if in column "J" user enter it's user ID
2. Format row "C - L" if user enter value in Column "I"

Both code seems to work when I have them execute on separate sheet, I need them to execute on the same sheet, I add them together and then I can get it to work... Anybody have any idea how would I need to combine them in order to work...

These are process step:
1. user enters disposition name (Accept, Reject, NCR etc) in column I, C-L row would be highlighted based on these value with colors assigned in vba code below.
2. in column J user enter his/her ID and soon ID is entered, current date would be assigned to column K

Anybody know how to integrate these two code/action based on sheet change.

Option Compare Text 'A=a, B=b, ... Z=z
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False


'------ Stamp Date in "K" when user id entered into "J" --------

  Const ColumnsToMonitor As String = "J"
  Const DateColumn As String = "K"
  
  On Error Resume Next
  If Not Intersect(Target, Columns(ColumnsToMonitor)) Is Nothing Then
    Intersect(Target.EntireRow, Columns(DateColumn)).Value = Now
        If Intersect(Target, Columns(ColumnsToMonitor)) = "" Then
            Intersect(Target.EntireRow, Columns(DateColumn)).Value = ""
        End If
  End If


  '-----   FORMAT ROW BASED ON USER INPUT IN "I" ------
 If Intersect(Target, Range("I17:I2000")) Is Nothing Then Exit Sub
    
    Select Case Cells(Target.Row, "I").Value
        Case "ACCEPT"
            Range(Cells(Target.Row, "C"), Cells(Target.Row, "L")).Interior.ColorIndex = 4
        Case "IHR"
            Range(Cells(Target.Row, "C"), Cells(Target.Row, "L")).Interior.ColorIndex = 24
        Case "NCR"
            Range(Cells(Target.Row, "C"), Cells(Target.Row, "L")).Interior.ColorIndex = 6
        Case "OSS"
            Range(Cells(Target.Row, "C"), Cells(Target.Row, "L")).Interior.ColorIndex = 45
        Case "REJECT"
            Range(Cells(Target.Row, "C"), Cells(Target.Row, "L")).Interior.ColorIndex = 3
        Case ""
            Range(Cells(Target.Row, "C"), Cells(Target.Row, "L")).Interior.ColorIndex = xlNone
        Case Else
            Range(Cells(Target.Row, "C"), Cells(Target.Row, "L")).Interior.ColorIndex = 2
        End Select

  Application.EnableEvents = True

  End Sub

[SamT]

One Event Sub = unlimited subSubs and Functions.

Just in case, all subSubs and Functions restore Application State.

Private Sub Worksheet_Change(ByVal Target As Range)

  If Target.Count > 1 Then Exit Sub
  
  If Intersect(Target, Range("J:J")) Is Nothing _
     And Intersect(Target, Range("I:I")) Is Nothing Then Exit Sub
  
  
  Application.EnableEvents = False
  
  If Target.Column = "J" Then DateStamp (Target.Row)
  If Target.Column = "I" Then FormatMyRow (Target.Row)
  
  Application.EnableEvents = True
End Sub

Private Function DateStamp(Rw As Long)
  Range("K" & Rw) = Date
  Application.EnableEvents = True
End Function

Private Function FormatMyRow(Rw As Long)

Dim CI As Long
  Select Case Range("I" & Rw).Value
    Case "ACCEPT": CI = 4
    Case "IHR": CI = 24
    Case "NCR": CI = 6
    Case "OSS": CI = 45
    Case "REJECT": CI = 3
    Case "": CI = xlNone
    Case Else: CI = 2
  End Select
  
  Range(Cells(Rw, "C"), Cells(Rw, "L")).Interior.ColorIndex = CI

  Application.EnableEvents = True
End Function

[izet99]

Hi SamT,

Thank you for you feedback. Not sure that I understand that does "Functions restore Application State" mean. Is there something I need to do additionally in order to execute code above. Do I put whole code on sheet level or do I add function to Module section?

------ update -----

Also, I try run code under sheet level and I don't see anything is happening?
or I get error

If Target.Column = "I" Then FormatMyRow (Target.Row)
  If Target.Column = "J" Then DateStamp (Target.Row)

Izet

[SamT]

Application.EnableEvents = False

Changes the Application's state so that Excel does not respond to events. To restore Excel (the application) to its previous default state, you need to use

Application.EnableEvents = True

All the code must be in the worksheet's code page.

I think you broke Excel. If you run some code and it stops after Application.EnableEvents = False but before restoring EnableEvents to True then Excel is broken.

Put the code below in any workbook in any module or worksheet and run it. I recommend the Personal workbook. This code works directly on Excel.

To fix Excel Run this code.

Sub RestoreApplication()
With Application
  .DisplayAlerts = True
  .Calculation = xlCalculationAutomatic
  .EnableEvents = True
  .CutCopyMode = False
  .ScreenUpdating = True
End With
End Sub

After you run that code try the other code

I have learned to not put the above Application calls in any code until it must be used. And I have a copy of RestoreApplication in Personal.xls. so I can run it any time from anywhere.

[izet99]

Hi SamT

I run code you provided to clear/fix the excel application... as suggested I have stored in my personal.xlsb so I can run as need in future...

than I have try code and I get type mismatch error at

If Target.Column = "I" Then FormatMyRow (Target.Row)
If Target.Column = "J" Then DateStamp (Target.Row)

Izet

[SamT]

Try changing
= "I" to = 9
and
= "J" to = 10

Column Numbers instead of Column Letters

[izet99]

Hi SamT,

This have worked, my test file work as intended, however when I transfer code to my master file, where code will be used in production I get:

Run-time error '1004':
Application-defined or object -defined error

Range(Cells(Rw, "C"), Cells(Rw, "L")).Interior.ColorIndex = CI

Try changing
= "I" to = 9
and
= "J" to = 10
Column Numbers instead of Column Letters