Worksheet Deactivate

[imback2nite]

I'm trying to get a handle on 'Deactivate'. My biggest problem are the users that forget to update the worksheet. I've been using the Command button and here is the code. It works but only when the users hit it. Sigh...

Private Sub CommandButton2_Click()
    Application.ScreenUpdating = False
    Addr = ActiveCell.Address
    ActiveSheet.Unprotect "4wink"
    Range("A:E").Copy
    Range("K:O").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A3:E75").ClearContents
    Range("G1:G75").Select
    Selection.Sort Key1:=Range("G1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Selection.Copy
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("I1:I75").Select
    Application.CutCopyMode = False
    Selection.Sort Key1:=Range("I1"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Selection.Copy
    Range("A150").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(2).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("$C2") = "=IF(A2="""","""",INDEX($M:$M,MATCH($A2,$K:$K,0)))"
    Range("$D2") = "=IF(B2="""","""",INDEX($N:$N,MATCH($A2,$K:$K,0)))"
    Range("$E2") = "=IF(C2="""","""",INDEX($O:$O,MATCH($A2,$K:$K,0)))"
    Dim lastRow As Long
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    Range("B2:E2").AutoFill Destination:=Range("B2:E" & lastRow)
    Range("C:E").Copy
    Range("C1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("C:E").Replace What:="#N/A", Replacement:=""
    Columns("C:E").Replace What:="0", Replacement:=""
    Columns("K:O").Delete
    Range(Addr).Select
    ActiveSheet.Protect "4wink", DrawingObjects:=False, Contents:=True, Scenarios:=True
    Application.ScreenUpdating = True
End Sub

I've been trying to write a different one for the deactivate but I just can't seem to get it. Any help would be appreciated. I think I'm having problems with 'selection' and how I can't use it if the user is trying to get to another worksheet.

Private Sub Worksheet_Deactivate()
    Application.ScreenUpdating = False
    With Sheet3
        .Unprotect "4wink"
        .Range("A:E").Copy
        .Range("K:O").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        .Range("A3:E75").ClearContents
        .Range("G1:G75").Sort Key1:=Range("G1"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
        .Range("G1:G75").Copy
        .Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        .Range("I1:I75").Sort Key1:=Range("I1"), Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
        .Range("I1:I75").Copy
        .Range("A150").End(xlUp).ActiveCell.Offset(2).Select
        .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        .Application.CutCopyMode = False
        .Range("$C2") = "=IF(A2="""","""",INDEX($M:$M,MATCH($A2,$K:$K,0)))"
        .Range("$D2") = "=IF(B2="""","""",INDEX($N:$N,MATCH($A2,$K:$K,0)))"
        .Range("$E2") = "=IF(C2="""","""",INDEX($O:$O,MATCH($A2,$K:$K,0)))"
    End With
        Dim lastRow As Long
        lastRow = Range("A" & Rows.Count).End(xlUp).Row
    With Sheet3
        .Range("B2:E2").AutoFill Destination:=Range("B2:E" & lastRow)
        .Range("C:E").Copy
        .Range("C1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        .Columns("C:E").Replace What:="#N/A", Replacement:=""
        .Columns("C:E").Replace What:="0", Replacement:=""
        .Columns("K:O").Delete
        .Protect "4wink", DrawingObjects:=False, Contents:=True, Scenarios:=True
    End With
    Application.ScreenUpdating = True
End Sub

 

[imback2nite]

Re: Help with Worksheet Deactivate

That worked! I don’t understand the On Error GoTo AcEvents. Is there an error I should still be looking for? But either way thank you! I did actually change the Sheet3 to With Me. Thank you DanteAmor and Fluff for all your help! One small thing. When the code runs it leaves columns C:E highlighted. Is there a way I can leave the active cell on Sheet3 selected? Actually any arbitrary cell other than the columns.

 

[DanteAmor]

Re: Help with Worksheet Deactivate

Try

Private Sub Worksheet_Deactivate()
    Application.ScreenUpdating = False
    Dim lastRow As Long
    On Error GoTo AcEvents
    Application.EnableEvents = False
    With [COLOR=#0000ff]Me[/COLOR]
        .Unprotect "4wink"
        .Range("A:E").Copy
        .Range("K:O").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        .Range("A3:E75").ClearContents
        .Range("G1:G75").Sort Key1:=.Range("G1"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
        .Range("G1:G75").Copy
        .Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        .Range("I1:I75").Sort Key1:=.Range("I1"), Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
        .Range("I1:I75").Copy
        .Range("A150").End(xlUp).Offset(2).PasteSpecial Paste:=xlPasteValues
        
        .Range("$C2") = "=IF(A2="""","""",INDEX($M:$M,MATCH($A2,$K:$K,0)))"
        .Range("$D2") = "=IF(B2="""","""",INDEX($N:$N,MATCH($A2,$K:$K,0)))"
        .Range("$E2") = "=IF(C2="""","""",INDEX($O:$O,MATCH($A2,$K:$K,0)))"
        lastRow = .Range("A" & Rows.Count).End(xlUp).Row
        .Range("B2:E2").AutoFill Destination:=.Range("B2:E" & lastRow)
        .Range("C:E").Copy
        .Range("C1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        .Columns("C:E").Replace What:="#N/A", Replacement:=""
        .Columns("C:E").Replace What:="0", Replacement:=""
        .Columns("K:O").Delete
        .Protect "4wink", DrawingObjects:=False, Contents:=True, Scenarios:=True
    End With
    [COLOR=#0000ff]Range("A1").Select[/COLOR]
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
AcEvents:
    Application.EnableEvents = True

End Sub