Private Sub Worksheet_Change(ByVal Target As Range)
' ********** CODE BLOCK 1 **********
Dim rng1 As Range
Dim cell1 As Range
' Check to see if any cells updated in range G2:G200 on "testdata" sheet
Set rng1 = Intersect(Target, Range("G2:G200"))
' Exit if no cells updated in that range
If rng1 Is Nothing Then Exit Sub
' Loop through updated cells
If Not rng1 Is Nothing Then
' Unprotect results sheet
Sheets("results").Activate
ActiveSheet.Unprotect
For Each cell1 In rng1
' If "Y" entered in column G, ...
If UCase(cell1) = "Y" Then
' then update column B of same row on "result" sheet
Sheets("results").Cells(cell1.Row, "B") = Now()
End If
Next cell1
' Reprotect sheet
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True
Sheets("testdata").Activate
End If
' ********** CODE BLOCK 2 **********
Dim rng As Range
Dim rng2 As Range
Dim cell As Range
Dim r As Long
Dim c As Long
Set rng = Intersect(Target, Range("E2:H200"))
' Exit sub if no cells updated in range
If rng Is Nothing Then Exit Sub
ActiveSheet.Unprotect
Application.EnableEvents = False
' Loop through updated cells in range
For Each cell In rng
' Get row and column number of updated cell
r = cell.Row
c = cell.Column
' Count how many cells have "Y" in current row
Set rng2 = Range("E" & r & ":H" & r)
If Application.WorksheetFunction.CountIf(rng2, "Y") > 1 Then
' Clear entry
cell.ClearContents
' Return message
MsgBox "You can put one Y in cell range E-H " & cell.Address(0, 0), vbOKOnly, "ERROR!"
ElseIf Application.WorksheetFunction.CountIf(rng2, "Y") = 1 Then
' See which column was updated and make appropriate adjustments
If LCase(cell) = "y" Then
Select Case c
' What to do if column E updated to "y"
Case 5
'enter any desired code here
' What to do if column F updated to "y"
Case 6
'enter any desired code here
' What to do if column G updated to "y"
Case 7
'enter any desired code here
' What to do if column H updated to "y"
Case 8
With Cells(r, "B")
.NumberFormat = "dd/mm/yyyy"
.Value = Date
End With
End Select
End If
Else
Cells(r, "B").Value = ""
End If
Next cell
Application.EnableEvents = True
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFormattingCells:=True
End Sub
ray:
