PDA

View Full Version : Solved: Track Cell Changes



hobbiton73
01-12-2013, 07:47 AM
Hi, I wonder whether someone may be able to help me please.

I'm using the script below to create a dynamic user 'Input form'.

Option Explicit
Public preValue As Variant

Private Sub Worksheet_Change(ByVal Target As Range)

Dim cell As Range, res As Variant
Dim rCell As Range
Dim Rng1 As Range
Dim Rng2 As Range
Dim Rng3 As Range
Dim lr As Long

If Target.Cells.Count > 1 Then Exit Sub
On Error GoTo EndNow
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.EnableCancelKey = xlDisabled
lr = lr

Application.EnableCancelKey = xlDisabled
Sheets("Input").Protect "password", UserInterFaceOnly:=True, AllowFiltering:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True

If Target.Cells.Count > 1 Then Exit Sub
On Error Resume Next


If Not Intersect(Target, Range("J7:J400")) Is Nothing Then
Set cell = Worksheets("Lists").Range("B2:C23")
res = Application.VLookup(Target, cell, 2, False)
If IsError(res) Then
Range("K" & Target.Row).Value = "Enter the name of the Project"
Else
Range("K" & Target.Row).Value = res
End If
End If




If Target.Cells.Count > 1 Then Exit Sub
On Error Resume Next

If Target.Column = 45 Then
If Target.Value = "Yes" Then
Set Rng1 = Application.Union(Cells(Target.Row, "B").Resize(, 19), Cells(Target.Row, "R"))
Rng1.Interior.ColorIndex = xlNone
Set Rng2 = Application.Union(Cells(Target.Row, "S").Resize(, 12), Cells(Target.Row, "AD"))
Rng2.Interior.ColorIndex = 37
Set Rng3 = Application.Union(Cells(Target.Row, "AF").Resize(, 12), Cells(Target.Row, "AQ"))
Rng3.Interior.ColorIndex = 42
End If
End If

With Target
Select Case True
Case .Column = 3
If .Value2 = "No" Then MsgBox "Please remember to make the same change to all rows for " & Target.Offset(0, -1).Value & " and delete any future forecasts"
Case Else
End Select
End With

With Target
Select Case True
Case .Column = 2
If .Value2 > 0 And .Offset(, -1).Value = "" Then
.Offset(, 2).Value2 = "Enter your Grade"
.Offset(, 3).Value2 = "Enter your Job Role"
.Offset(, 4).Value2 = "--Select--"
.Offset(, 6).Value2 = "R&D"
.Offset(, 7).Value2 = "--Select--"
.Offset(, 16).Value2 = "Enter the name of your Line Manager"
End If

Case .Column = 9
If .Value2 = "P" Then
.Offset(, 1).Value2 = "Enter the Project Code"
.Offset(, 3).Value2 = "--Select--"
.Offset(, 6).Value2 = "Enter the Work Package End date"
.Offset(, 7).Value2 = "--Select--"
.Offset(, 8).Value2 = "Enter the name of your Work Manager"
Else
.Offset(, 1).Value2 = "--Select--"
End If
Case Else
End Select
End With

With Target
Select Case True
Case .Column = 9

If .Value2 = "E" Then
.Offset(, 1).Value2 = ""
.Offset(, 1).Locked = True
.Offset(, 2).Value2 = "Enter the name of the Enhancement(s)"
.Offset(, 3).Value2 = "--Select--"
.Offset(, 6).Value2 = "Enter the Work Package End date"
.Offset(, 7).Value2 = "--Select--"
.Offset(, 8).Value2 = "Enter the name of your Work Manager"
Else
.Offset(, 1).Locked = False
.Offset(, 2).Value2 = ""
End If
Case Else
End Select
End With

With Target
Select Case True
Case .Column = 9

If .Value2 = "BC" Or .Value2 = "BNC" Then
.Offset(, 1).Value2 = "--Select--"
.Offset(, 3).Value2 = "--Select--"
.Offset(, 6).Value2 = "Enter the Work Package End date"
.Offset(, 7).Value2 = "--Select--"
.Offset(, 8).Value2 = "Enter the name of your Work Manager"
End If
Case Else
End Select
End With

With Target
Select Case True
Case .Column = 9

If .Value2 = "OH" Then
.Offset(, 3).Value2 = ""
.Offset(, 3).Locked = True
.Offset(, 6).Value2 = ""
.Offset(, 6).Locked = True
.Offset(, 7).Value2 = ""
.Offset(, 7).Locked = True
.Offset(, 8).Value2 = ""
.Offset(, 8).Locked = True
Else
.Offset(, 3).Locked = False
.Offset(, 6).Locked = False
.Offset(, 7).Locked = False
.Offset(, 8).Locked = False
End If
Case Else
End Select
End With

If Not Intersect(Target, Range("B5:AD400", "AF5:AQ400")) Is Nothing Then
If Target.Value <> preValue And Target.Value <> "" Then
Application.EnableEvents = False
With Rows(Target.Row)
.Range("A1").Value = Date
.Range("AS1").Value = "No"
End With
Application.EnableEvents = True
Target.Interior.ColorIndex = 35
Columns(Target.Column).AutoFit
End If
End If


EndNow:
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.EnableCancelKey = xlInterrupt
End Sub
The form works fine except for one area which is handled by this piece of the script:

If Not Intersect(Target, Range("B5:AD400", "AF5:AQ400")) Is Nothing Then
If Target.Value <> preValue And Target.Value <> "" Then
Application.EnableEvents = False
With Rows(Target.Row)
.Range("A1").Value = Date
.Range("AS1").Value = "No"
End With
Application.EnableEvents = True
Target.Interior.ColorIndex = 35
Columns(Target.Column).AutoFit
End If
End If
What I'm trying to do, is when a cell value is amended or changed in the ranges shown, I would like column A to show the date of change, highlight the cell that has been amended, and add the word 'No' to column AS.

Unfortunately, none of these functions work.

I've tried changing the code to:

With Target
Select Case True
Case Not Intersect(Target, Range("B5:AD400", "AF5:AQ400")) Is Nothing
If .Value2 <> preValue And .Value2 <> "" Then
With Rows(lr)
.Range("A1").Value = Date
End With
.Interior.ColorIndex = 35
Columns(.Column).AutoFit
End If
Case Else
End Select
End With
but unfortunately, I still can't get this to work.

I just wondered whether someone may be able to look at this please and let me know where I'm going wrong.

Many thanks and kind regards

Chris

hobbiton73
01-12-2013, 11:04 AM
All, thank you very much for taking the time to view my post.

After more research I found the solution by using the following:

If Not Intersect(Target, Range("B5:AD400", "AF5:AQ400")) Is Nothing Then
If Target.Value <> preValue And Target.Value <> "" Then
Application.EnableEvents = False
With Rows(Target.Row)
.Range("A1").Value = Date
.Range("AS1").Value = "No"
End With
Application.EnableEvents = True
Target.Interior.ColorIndex = 35
End If
End If


With Target
Columns("A:R").EntireColumn.AutoFit
End With
Many thanks and kind regards

Chris