Combining another worksheet change

[stewart1]

Hi to all.

I have these two events that I need to run with a worksheet change but I cannot seem to get it right.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range, i As Long
    On Error Resume Next
    Set c = Intersect(Target, Columns(3))
    If c Is Nothing Then Exit Sub
    If IsEmpty(c.Offset(-1, 0)) Or Not IsEmpty(c.Offset(1, 0)) Then Exit Sub
    i = c.Row
    Application.EnableEvents = False
    Range("A" & i - 1 & ":B" & i - 1).Copy Range("A" & i & ":B" & i)
    Application.EnableEvents = True
    On Error GoTo 0
End Sub

And,

Private Sub Worksheet_Change(ByVal Target As Range)  
Const sWSPWD As String = ""
If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Me.Range("F3:F10000")) Is Nothing Then
        Me.Unprotect ""
        If Target.Offset(, 2) = "" Then Target.Offset(, 2) = Date
        Me.Protect ""
    ElseIf Not Intersect(Target, Me.Range("L3:L10000")) Is Nothing Then
        ActiveSheet.Unprotect ""
        If Target.Offset(, 1) = "" Then Target.Offset(, 1) = Date
        ActiveSheet.Protect ""
        ElseIf Not Intersect(Target, Me.Range("O3:O10000")) Is Nothing Then
        ActiveSheet.Unprotect ""
        If Target.Offset(, 1) = "" Then Target.Offset(, 1) = Date
        ActiveSheet.Protect ""
        ElseIf Not Intersect(Target, Me.Range("T3:T10000")) Is Nothing Then
        ActiveSheet.Unprotect ""
        If Target.Offset(, 1) = "" Then Target.Offset(, 1) = Date
        ActiveSheet.Protect ""
    End If
End Sub

If anyone can solve this I would be grateful,


Thanks.

 

[stewart1]

Anyone got any ideas please?


Thanks

 

[stewart1]

Okay. I got this going myself shown below

Private Sub Worksheet_Change(ByVal Target As Range)
Const sWSPWD As String = ""
Dim c As Range, i As Long
If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Me.Range("F3:F10000")) Is Nothing Then
        Me.Unprotect ""
        If Target.Offset(, 2) = "" Then Target.Offset(, 2) = Date
        Me.Protect ""
    ElseIf Not Intersect(Target, Me.Range("L3:L10000")) Is Nothing Then
        ActiveSheet.Unprotect ""
        If Target.Offset(, 1) = "" Then Target.Offset(, 1) = Date
        ActiveSheet.Protect ""
        ElseIf Not Intersect(Target, Me.Range("O3:O10000")) Is Nothing Then
        ActiveSheet.Unprotect ""
        If Target.Offset(, 1) = "" Then Target.Offset(, 1) = Date
        ActiveSheet.Protect ""
        ElseIf Not Intersect(Target, Me.Range("T3:T10000")) Is Nothing Then
        ActiveSheet.Unprotect ""
        If Target.Offset(, 1) = "" Then Target.Offset(, 1) = Date
        ActiveSheet.Protect ""
    End If
    On Error Resume Next
    Set c = Intersect(Target, Columns(3))
    If c Is Nothing Then Exit Sub
    If IsEmpty(c.Offset(-1, 0)) Or Not IsEmpty(c.Offset(1, 0)) Then Exit Sub
    i = c.Row
    Application.EnableEvents = False
    Range("A" & i - 1 & ":B" & i - 1).Copy Range("A" & i & ":B" & i)
    Application.EnableEvents = True
    On Error GoTo 0
End Sub

but I when I add this to the existing code the added one doesn't work

Dim c As Range, i As Long
    On Error Resume Next
    Set c = Intersect(Target, Columns(16))
    If c Is Nothing Then Exit Sub
    If IsEmpty(c.Offset(1, 0)) Or Not IsEmpty(c.Offset(-1, 0)) Then Exit Sub
    i = c.Row
    Application.EnableEvents = False
    Range("Q" & i - 1).Copy Range("Q" & i)
    Application.EnableEvents = True
    On Error GoTo 0

As you can see the targest column 16(Q)should auto update formula when
date is auto offset entered as above code shows. Here is that code

ElseIf Not Intersect(Target, Me.Range("O3:O10000")) Is Nothing Then
        ActiveSheet.Unprotect ""
        If Target.Offset(, 1) = "" Then Target.Offset(, 1) = Date
        ActiveSheet.Protect ""

I think that I need an Else If statement here but I have tried so many different ways to correct it I am lost.

Thanks for looking.

Stewart

 

[stewart1]

Please if anyone can advise me how I can achieve this, I would be grateful.

Thanks