VBA Code should not be running twice

[djfatboyfats]

Good afternoon,

I don't know really where to start to try and explain this, but I give it a good shot.

Sheets within my workbook

New Data
Data

New Data sheet has a data source query which counts the amount of records in a table (This refreshes every 5 minutes)
Data sheet is the same table but displays all the columns and information


This code below looks for any entry in K2 and if blank exits the sub and doesn't run.

The formula in K2 is

=IF(Table_Query_from_csolve3[[#Totals],[ACCOUNTS]]>COUNTA(Table_Query_from_csolve[DebtorID]),1,"")

This basically says, if there are more accounts in the count table then the what you have displayed in the data table then show a 1.
The code below then says if there is a 1 then run the code if not skip it.

Sub Refresh()
If Worksheets("Data").Range("K2").Value = "" Then Exit Sub
Sheets("Data").Select
Range("Table_Query_from_csolve[[#Headers],[DebtorID]]").Select
    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range

    ' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    Set KeyCells = Range("B2")
    
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then

        ' Display a message when one of the designated cells has been
        ' changed.
Sheets("Data").Select
   ' Select the range of cells on the active worksheet.
   With Sheets("Data").Range("B1:H2")
   ActiveSheet.Range("B1:H2").Select
   End With
   ' Show the envelope on the ActiveWorkbook.
   ActiveWorkbook.EnvelopeVisible = True
   
   ' Set the optional introduction field thats adds
   ' some header text to the email body. It also sets
   ' the To and Subject lines. Finally the message
   ' is sent.
   With ActiveSheet.MailEnvelope
      '.Introduction = ""
      .Item.To = "[email protected]"
      .Item.Subject = "[Auto Mailer] - New Card Test - " & Format(Date, "ddmmyy")
      .Item.Send
   End With
    End If
End Sub

The code is then controlled by an On time Time Value command

Private Sub Workbook_Open()

'Cancel any previous scheduled run
    On Error Resume Next
    Application.OnTime TimeValue("08:10:00"), "Refresh", , False
    Application.OnTime TimeValue("08:20:00"), "Refresh", , False
    Application.OnTime TimeValue("08:30:00"), "Refresh", , False
    Application.OnTime TimeValue("08:40:00"), "Refresh", , False
    Application.OnTime TimeValue("08:50:00"), "Refresh", , False
    Application.OnTime TimeValue("09:00:00"), "Refresh", , False
    On Error GoTo 0

'Add scheduled run again
    Application.OnTime TimeValue("08:10:00"), "Refresh"
    Application.OnTime TimeValue("08:20:00"), "Refresh"
    Application.OnTime TimeValue("08:30:00"), "Refresh"
    Application.OnTime TimeValue("08:40:00"), "Refresh"
    Application.OnTime TimeValue("08:50:00"), "Refresh"
    Application.OnTime TimeValue("09:00:00"), "Refresh"
    End Sub

The problem is that when this code does run it sends the email twice, and for the life of me I cannot work out why. I've tried numerous things to fix the issue like turning the Background Refresh off from the data source and changing the way its refreshed but still I get 2 email most times, sometimes I do only get 1 which makes it even more weird.

If someone could shed some light on this it would be very much appreciated.

Kind Regards

DJ

[ragulduy]

Have you tried turning off enableevents when running your worksheet_change sub? i.e.

private sub worksheet_change(byval target as range)
application.enableevents = false
'code
application.enableevents = true
end sub

[djfatboyfats]

I will give it a try, thanks for your response, I will let you know how I get on.

[djfatboyfats]

I believe that has worked thank you.

[djfatboyfats]

Good morning, I thought this worked but unfortunately it has been running twice again, is there anything else I can try?