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'.
[vba]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[/vba]
The form works fine except for one area which is handled by this piece of the script:
[vba] 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[/vba]
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:
[vba]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[/vba]
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
Reply With Quote