I have a macro set up to run once a minute to bring in values from an outside source. I basically copied a code example that I saw to stop the macro from running when the workbook is closed, but it isn't working properly. I've set up a button to call stopmacro, but that doesn't stop it from updating either. The code compiles/runs, but just doesn't seem to do anything. Here's the module in its entirety (I apologize if it doesn't look pretty):
Sub startmacro()
Dim nextrun As Date
Option Explicit
Call ThisWorkbook.refresh
End Sub
Sub refresh()
nextrun = Now + TimeValue("00:01:00")
Application.OnTime nextrun, "ThisWorkbook.refresh"
Call checkall
End Sub
Sub check()
Dim count As Long
Dim count2 As Long
Dim hsbm_speed_ok As Long
Dim i As Long
Dim j As Long
count = 0
count2 = 0
hsbm_speed_ok = 0
Dim this_sheet As String
this_sheet = ActiveSheet.Name
Range("B2").Value = this_sheet & ":SEALSPEED1.CU"
Range("C2").Value = this_sheet & ":CARTSNAP.CU"
Range("D2").Value = this_sheet & ":OMSCARTONS.PV"
Range("E2").Value = this_sheet & ":NOCARTON1.CU"
ActiveSheet.Range("A1").Select
For i = 59 To 63
If Cells(i, 3).Value >= Cells(i, 2).Value - 0.2 Then
Selection.Characters.Text = "Increase Top Sealer Speed"
With Selection.Characters(Start:=1, Length:=25).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 20
.ColorIndex = 3
End With
Range("E3").Select
Exit For
ElseIf Cells(i, 5).Value >= Cells(3, 5).Value + 5 Then
For j = 5 To i
If Cells(j, 5).Value = Cells(j - 1, 5).Value + 1 And Cells(j - 1, 5).Value = Cells(j - 2, 5).Value + 1 Then
hsbm_speed_ok = 1
End If
Next j
If hsbm_speed_ok = 0 Then
Selection.Characters.Text = "Increase Bottom Maker Speed"
With Selection.Characters.Font
.ColorIndex = 3
End With
End If
ElseIf Cells(i, 3).Value >= Cells(i, 2).Value - 25 And Cells(i, 3).Value <= Cells(i, 2).Value - 5 Then
count = count + 1
If count >= 4 Then
Selection.Characters.Text = "Make Filler Adjustments"
With Selection.Characters.Font
.ColorIndex = 3
End With
End If
ElseIf Cells(i, 3).Value >= Cells(i, 2).Value - 4 And Cells(i, 3).Value < Cells(i, 2).Value Then
count2 = count2 + 1
If count2 >= 4 Then
Selection.Characters.Text = "No Major Adjustments Necessary"
With Selection.Characters.Font
.ColorIndex = 10
End With
End If
Else
Selection.Characters.Text = "No Assessment"
With Selection.Characters.Font
.ColorIndex = 5
End With
End If
Next i
Range("A2").Activate
End Sub
Sub checkall()
Dim cur_sheet As String
cur_sheet = ActiveSheet.Name
Application.ScreenUpdating = False
Worksheets("LL01").Activate
Call check
Worksheets("LL02").Activate
Call check
Worksheets("LL03").Activate
Call check
Worksheets("LL04").Activate
Call check
Worksheets("LL05").Activate
Call check
Worksheets("LL06").Activate
Call check
Worksheets("LL07").Activate
Call check
Worksheets("LL08").Activate
Call check
Worksheets("LL09").Activate
Call check
Worksheets("LL09").Activate
Call check
Worksheets("LL10").Activate
Call check
Worksheets("LL11").Activate
Call check
Worksheets("LL14").Activate
Call check
Worksheets("All").Activate
Range("B1").Characters.Font.Color = Worksheets("LL01").Range("A1").Characters.Font.Color
Range("B3").Characters.Font.Color = Worksheets("LL02").Range("A1").Characters.Font.Color
Range("B5").Characters.Font.Color = Worksheets("LL03").Range("A1").Characters.Font.Color
Range("B7").Characters.Font.Color = Worksheets("LL04").Range("A1").Characters.Font.Color
Range("B9").Characters.Font.Color = Worksheets("LL05").Range("A1").Characters.Font.Color
Range("B11").Characters.Font.Color = Worksheets("LL06").Range("A1").Characters.Font.Color
Range("J1").Characters.Font.Color = Worksheets("LL07").Range("A1").Characters.Font.Color
Range("J3").Characters.Font.Color = Worksheets("LL08").Range("A1").Characters.Font.Color
Range("J5").Characters.Font.Color = Worksheets("LL09").Range("A1").Characters.Font.Color
Range("J7").Characters.Font.Color = Worksheets("LL10").Range("A1").Characters.Font.Color
Range("J9").Characters.Font.Color = Worksheets("LL11").Range("A1").Characters.Font.Color
Range("J11").Characters.Font.Color = Worksheets("LL14").Range("A1").Characters.Font.Color
Worksheets(cur_sheet).Activate
Application.ScreenUpdating = True
End Sub
Sub Auto_Close()
Call ThisWorkbook.stopmacro
End Sub
Sub stopmacro()
On Error Resume Next
Application.OnTime EarliestTime:=Now, Procedure:="ThisWorkbook.refresh", LatestTime:=Now + 30, Schedule:=False
End Sub
Anyone know why it won't stop updating?
Sub startmacro()
Dim nextrun As Date
Option Explicit
Call ThisWorkbook.refresh
End Sub
Sub refresh()
nextrun = Now + TimeValue("00:01:00")
Application.OnTime nextrun, "ThisWorkbook.refresh"
Call checkall
End Sub
Sub check()
Dim count As Long
Dim count2 As Long
Dim hsbm_speed_ok As Long
Dim i As Long
Dim j As Long
count = 0
count2 = 0
hsbm_speed_ok = 0
Dim this_sheet As String
this_sheet = ActiveSheet.Name
Range("B2").Value = this_sheet & ":SEALSPEED1.CU"
Range("C2").Value = this_sheet & ":CARTSNAP.CU"
Range("D2").Value = this_sheet & ":OMSCARTONS.PV"
Range("E2").Value = this_sheet & ":NOCARTON1.CU"
ActiveSheet.Range("A1").Select
For i = 59 To 63
If Cells(i, 3).Value >= Cells(i, 2).Value - 0.2 Then
Selection.Characters.Text = "Increase Top Sealer Speed"
With Selection.Characters(Start:=1, Length:=25).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 20
.ColorIndex = 3
End With
Range("E3").Select
Exit For
ElseIf Cells(i, 5).Value >= Cells(3, 5).Value + 5 Then
For j = 5 To i
If Cells(j, 5).Value = Cells(j - 1, 5).Value + 1 And Cells(j - 1, 5).Value = Cells(j - 2, 5).Value + 1 Then
hsbm_speed_ok = 1
End If
Next j
If hsbm_speed_ok = 0 Then
Selection.Characters.Text = "Increase Bottom Maker Speed"
With Selection.Characters.Font
.ColorIndex = 3
End With
End If
ElseIf Cells(i, 3).Value >= Cells(i, 2).Value - 25 And Cells(i, 3).Value <= Cells(i, 2).Value - 5 Then
count = count + 1
If count >= 4 Then
Selection.Characters.Text = "Make Filler Adjustments"
With Selection.Characters.Font
.ColorIndex = 3
End With
End If
ElseIf Cells(i, 3).Value >= Cells(i, 2).Value - 4 And Cells(i, 3).Value < Cells(i, 2).Value Then
count2 = count2 + 1
If count2 >= 4 Then
Selection.Characters.Text = "No Major Adjustments Necessary"
With Selection.Characters.Font
.ColorIndex = 10
End With
End If
Else
Selection.Characters.Text = "No Assessment"
With Selection.Characters.Font
.ColorIndex = 5
End With
End If
Next i
Range("A2").Activate
End Sub
Sub checkall()
Dim cur_sheet As String
cur_sheet = ActiveSheet.Name
Application.ScreenUpdating = False
Worksheets("LL01").Activate
Call check
Worksheets("LL02").Activate
Call check
Worksheets("LL03").Activate
Call check
Worksheets("LL04").Activate
Call check
Worksheets("LL05").Activate
Call check
Worksheets("LL06").Activate
Call check
Worksheets("LL07").Activate
Call check
Worksheets("LL08").Activate
Call check
Worksheets("LL09").Activate
Call check
Worksheets("LL09").Activate
Call check
Worksheets("LL10").Activate
Call check
Worksheets("LL11").Activate
Call check
Worksheets("LL14").Activate
Call check
Worksheets("All").Activate
Range("B1").Characters.Font.Color = Worksheets("LL01").Range("A1").Characters.Font.Color
Range("B3").Characters.Font.Color = Worksheets("LL02").Range("A1").Characters.Font.Color
Range("B5").Characters.Font.Color = Worksheets("LL03").Range("A1").Characters.Font.Color
Range("B7").Characters.Font.Color = Worksheets("LL04").Range("A1").Characters.Font.Color
Range("B9").Characters.Font.Color = Worksheets("LL05").Range("A1").Characters.Font.Color
Range("B11").Characters.Font.Color = Worksheets("LL06").Range("A1").Characters.Font.Color
Range("J1").Characters.Font.Color = Worksheets("LL07").Range("A1").Characters.Font.Color
Range("J3").Characters.Font.Color = Worksheets("LL08").Range("A1").Characters.Font.Color
Range("J5").Characters.Font.Color = Worksheets("LL09").Range("A1").Characters.Font.Color
Range("J7").Characters.Font.Color = Worksheets("LL10").Range("A1").Characters.Font.Color
Range("J9").Characters.Font.Color = Worksheets("LL11").Range("A1").Characters.Font.Color
Range("J11").Characters.Font.Color = Worksheets("LL14").Range("A1").Characters.Font.Color
Worksheets(cur_sheet).Activate
Application.ScreenUpdating = True
End Sub
Sub Auto_Close()
Call ThisWorkbook.stopmacro
End Sub
Sub stopmacro()
On Error Resume Next
Application.OnTime EarliestTime:=Now, Procedure:="ThisWorkbook.refresh", LatestTime:=Now + 30, Schedule:=False
End Sub
Anyone know why it won't stop updating?