Private Sub Worksheet_Activate() to run once and not all the time

[Excelnoub]

Good day,
This is a wierd question. I have a code that selects sheets to sheet... .find and match. I have another code in one of my sheet that will, on Worksheet_Activate, will search for dates in one of my column then return a msgbox letting me know that that date is overdue.

Perfect... Now the problem is when I select this sheet, code will run. I have another procedure within that sheet that copies and paste the information from one sheet to another and then returns to this sheet and will again run the date code:

Private Sub Worksheet_Activate()
    Set rng = Range("V5:V100")
    Application.EnableEvents = False
    For Each cl In rng
        If IsDate(cl.Value) And CDate(cl.Value) <= Date Then
            MsgBox ("Delivery follow up on file " & Range("N" & cl.Row) & " " & Range("O" & cl.Row))       
        End If
    Next cl
    Application.EnableEvents = True
End Sub

As you can see this codes will loop once.

This code will send my info to my next sheet, comeback and sort:

'command button_click()
Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 28)).Copy
        Sheets("Archives").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        'This clears the content in the selected row from A to Y and Sort row 5 to 100
        Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 28)).Interior.ColorIndex = xlNone
        Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 28)).ClearContents
        
    With ActiveWorkbook.Worksheets("Report").Sort
        .SetRange Range("A5:AB100")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

This is very annoying, any way that I could turn the loop code to only run, hard to explain, only when the sheet is manually selected? and not always run when another code will run?

[notreallyIT]

Would putting application.enableevents = false not stop the worksheet_activate event from firing?

[sktneer]

Probably one way to declare a Static counter variable in Worksheet_Activate even code. Try the code below to see whether it works or not.

Private Sub Worksheet_Activate()
    Static cnt As Integer
    If cnt > 0 Then
        Exit Sub
    End If
    Set Rng = Range("V5:V100")
    Application.EnableEvents = False
    For Each cl In Rng
        If IsDate(cl.Value) And CDate(cl.Value) <= Date Then
            MsgBox ("Delivery follow up on file " & Range("N" & cl.Row) & " " & Range("O" & cl.Row))
            cnt = cnt + 1
        End If
    Next cl
    Application.EnableEvents = True
End Sub

[Excelnoub]

Thank you guys... notreallyIT you were right I forgot to add more application.enableevents = false as one was left at True...


Thank you :D

[Excelnoub]

Sorry my Complete code was the following:

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    If IsEmpty(ActiveCell) Then
        MsgBox "Selected cell is empty. ", vbExclamation, "No Requisition Number"
    Unload Me
    Application.EnableEvents = True
    Exit Sub
    End If
    
    If WorksheetFunction.CountIf(Range("A5:A" & Range("A" & Rows.Count).End(xlUp).Row), "=" & ActiveCell.Value) > 1 Then
    'do nothing
    Application.EnableEvents = True
    Else
        MsgBox "This was the final delivery for file " & Range("A" & ActiveCell.Row) & ". You may now archive the physical file."
    End If
    
        Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 28)).Copy
        Sheets("Archives").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        'This clears the content in the selected row from A to Y and Sort row 5 to 100
        Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 28)).Interior.ColorIndex = xlNone
        Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 28)).ClearContents
        
    With ActiveWorkbook.Worksheets("Report").Sort
        .SetRange Range("A5:AB100")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Unload Me
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub