PDA

View Full Version : Conditional Format with Date Stamp based on user input



izet99
01-14-2015, 10:10 AM
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
01-14-2015, 11:45 PM
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
01-15-2015, 01:21 PM
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
01-15-2015, 02:20 PM
Application.EnableEvents = FalseChanges 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
01-15-2015, 03:08 PM
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
01-15-2015, 04:03 PM
Try changing
= "I" to = 9
and
= "J" to = 10

Column Numbers instead of Column Letters

izet99
01-16-2015, 10:02 AM
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