G'day guys,
I have a long sub and it runs on a 9 second loop for 9 hours per day.
It may crash once or twice a day.
The instant solution is to hit a "stop button" which is on the program within excel and hit a "restart button" commencing the sub routines again.
Ultimately the dream... for it not to crash for it to run for the entire 9 hour period without issues.
Can anyone see any major issues this may be?
I have a long sub and it runs on a 9 second loop for 9 hours per day.
It may crash once or twice a day.
The instant solution is to hit a "stop button" which is on the program within excel and hit a "restart button" commencing the sub routines again.
Ultimately the dream... for it not to crash for it to run for the entire 9 hour period without issues.
Can anyone see any major issues this may be?
Code:
Public v As IntegerSub BeginAutomation()
Application.ScreenUpdating = False
v = 0
Dim Msg As String, Ans As Variant
Msg = "You're about to begin automation do you wish to proceed?"
Ans = MsgBox(Msg, vbYesNo)
Select Case Ans
Case vbYes
Call Timercontrol
Case vbNo
GoTo Quit:
End Select
Application.ScreenUpdating = True
Quit:
End Sub
' restartcode()
'Dim cbrReset As CommandBarButton
'Dim cbrRunSub As CommandBarButton
'Set cbrReset = Application.VBE.CommandBars(1).Controls("&Run").Controls("&Reset")
' cbrReset.Execute
'Set cbrRubSub = Application.VBE.CommandBars(1).Controls("&Run").Controls("&RunSub")
'cbrRunSub.Execute
' Call Timercontrol
'End Sub
Sub STOPAUTOMATION()
Application.ScreenUpdating = False
Range("XFC8").Value = "1"
ActiveWorkbook.Save
If Range("XFC8").Value = "1" Then Call EXITAUTO
Exit Sub
Application.ScreenUpdating = True
End Sub
Sub Timercontrol()
Application.ScreenUpdating = False
If v = 0 Then
TimeToRun = Now + TimeValue("00:00:09")
Application.OnTime TimeToRun, "LoadDownpipe"
Else
Exit Sub
End If
Application.ScreenUpdating = True
End Sub
Sub LoadDownpipe()
Application.ScreenUpdating = False
Dim r As Long, ws As Worksheet
Dim wb As Workbook
Set wb = Workbooks("Best Shed Scheduler Flashing.xlsm")
If Sheets("Downpipe Machine Batch").Range("N3") = 3 And Sheets("Downpipe Machine Batch").Range("P3").Value = 1 And Sheets("Downpipe Machine Batch").Range("AJ3") = 0 Then
Sheets("Downpipe Machine Batch").Range("AJ3") = 2
'''Job has been completed TIME STAMP
Sheets("Downpipe Machine Batch").Range("AN3").Value = Now
''Engage the move of completed downpipe batch once completed triggers are found
Call movecompletedDownpipe
End If
''Run the Load''
If Sheets("Downpipe Machine Batch").Range("N3") = 3 And Sheets("Downpipe Machine Batch").Range("P3").Value = 1 And Sheets("Downpipe Machine Batch").Range("AJ3").Value = 4 Then
'Any more jobs to load?
If Sheets("Downpipe Machine Data").Range("A3") >= 1 Then
Sheets("Downpipe Machine Batch").Range("AJ3") = "1"
''Load next job
ThisWorkbook.Sheets("Downpipe Machine Batch").Range("B6").Value = ThisWorkbook.Sheets("Downpipe Machine Data").Range("A3").Value ''AS B2 in Data sheet is always going to be current First in First out concept
For i = 3 To 50000 ''count how many lines for this job (as jobs will always be stacked together this is easy to find
If Not ThisWorkbook.Sheets("Downpipe Machine Data").Range("A" & i).Value = ThisWorkbook.Sheets("Downpipe Machine Batch").Range("B6").Value Then
Exit For
End If
Next i
'''Need help with this section getting rid of selects - need it to jump between sheets but can't work out how to do it
Sheets("Downpipe Machine Data").Range("A3:Z" & i - 1).Copy
Sheets("Downpipe Machine Batch").Cells(3, 1).PasteSpecial Paste:=xlValues
''''TIME STAMP LOAD IN
Sheets("Downpipe Machine Batch").Range("AM3").Value = Now
'''Remove data from the original DATA Sheet from Downpipe Machine Sheet where the Batch originated from
ThisWorkbook.Sheets("Downpipe Machine Data").Rows("3:" & i - 1).Delete
'''WIRTE Zeros if No QTY/Length is present to enforce machine register START
Set ws = Sheets("Downpipe Machine Batch")
For r = 4 To 14
If ws.Range("F" & r).Value = "" Then ws.Range("F" & r & ":G" & r) = "0"
Next r
'''Tell the machine the job has been loaded
Sheets("Downpipe Machine Batch").Range("R3") = "1"
'Application.Wait (Now + TimeValue("0:00:05"))
End If
End If
'''New code - test first
If Sheets("Downpipe Machine Batch").Range("AK3") = 1 Then
Sheets("Downpipe Machine Batch").Range("R3") = 0
Sheets("Downpipe Machine Batch").Range("AJ3") = 0
End If
Call LoadGutter
Application.ScreenUpdating = True
End Sub
Sub movecompletedDownpipe()
Application.ScreenUpdating = False
Dim ws As Worksheet, Lastrow As Long
Dim ws2 As Worksheet
Set ws = Sheets("Downpipe Machine Batch")
''Move the job to daily recorded sheet
'ThisWorkbook.Sheets("Downpipe Machine Batch").Range("B6").Value = ThisWorkbook.Sheets("Downpipe Machine").Range("B6").Value ''AS B2 in Data sheet is always going to be current First in First out concept
For i = 4 To 50000 ''count how many lines for this job (as jobs will always be stacked together this is easy to find
If Not ThisWorkbook.Sheets("Downpipe Machine Batch").Range("A" & i).Value = ThisWorkbook.Sheets("Downpipe Machine Batch").Range("A3").Value Then
Exit For
End If
Next i
ws.Range("A3:AN" & i - 1).Copy
Set ws2 = Sheets("Downpipe Job List")
Lastrow = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row + 1
Sheets("Downpipe Job List").Range("A" & Lastrow).PasteSpecial Paste:=xlPasteValues
'Sheets("Downpipe").Range("A" & Cells(Rows.Count, "A").End(xlUp).Row).PasteSpecial Paste:=xlPasteValues
Call ClearDownpipeBatch
Application.ScreenUpdating = True
End Sub
Sub ClearDownpipeBatch()
Application.ScreenUpdating = False
Dim ws As Worksheet
Set ws = Sheets("Downpipe Machine Batch")
With ws
For i = 4 To 50000 ''count how many lines for this job (as jobs will always be stacked together this is easy to find
If Not ThisWorkbook.Sheets("Downpipe Machine Batch").Range("A" & i).Value = ThisWorkbook.Sheets("Downpipe Machine Batch").Range("A3").Value Then
Exit For
End If
Next i
.Range("A3:CC" & i - 1).ClearContents
.Range("AJ3") = 4
End With
Call LoadDownpipe
Application.ScreenUpdating = True
End Sub
Sub LoadGutter()
Application.ScreenUpdating = False
Dim r As Long, ws As Worksheet
Dim wb As Workbook
Set wb = Workbooks("Best Shed Scheduler Flashing.xlsm")
'If Sheets("Gutter Machine Batch").Range("R3") = 1 And Sheets("Gutter Machine Batch").Range("AJ3") = 1 And Sheets("Gutter Machine Batch").Range("AK3") = 0 Then
'Sheets("Gutter Machine Batch").Range("R3") = 0
'Sheets("Gutter Machine Batch").Range("AJ3") = 0
'End If
If Sheets("Gutter Machine Batch").Range("N3") = 3 And Sheets("Gutter Machine Batch").Range("P3").Value = 1 And Sheets("Gutter Machine Batch").Range("AJ3") = 0 Then
Sheets("Gutter Machine Batch").Range("AJ3") = 2
Sheets("Gutter Machine Batch").Range("AN3").Value = Now
Call movecompletedGutter
End If
''Run the Load''
If Sheets("Gutter Machine Batch").Range("N3") = 3 And Sheets("Gutter Machine Batch").Range("P3").Value = 1 And Sheets("Gutter Machine Batch").Range("AJ3").Value = 4 Then
'NEW SHORT CODE
If Sheets("Gutter Machine Data").Range("A3") >= 1 Then
Sheets("Gutter Machine Batch").Range("AJ3") = "1"
''Load next job
ThisWorkbook.Sheets("Gutter Machine Batch").Range("B6").Value = ThisWorkbook.Sheets("Gutter Machine Data").Range("A3").Value ''AS B2 in Data sheet is always going to be current First in First out concept
For i = 3 To 50000 ''count how many lines for this job (as jobs will always be stacked together this is easy to find
If Not ThisWorkbook.Sheets("Gutter Machine Data").Range("A" & i).Value = ThisWorkbook.Sheets("Gutter Machine Batch").Range("B6").Value Then
Exit For
End If
Next i
'''Need help with this section getting rid of selects - need it to jump between sheets but can't work out how to do it
Sheets("Gutter Machine Data").Range("A3:Z" & i - 1).Copy
Sheets("Gutter Machine Batch").Cells(3, 1).PasteSpecial Paste:=xlValues
''''TIME STAMP LOAD IN
Sheets("Gutter Machine Batch").Range("AM3").Value = Now
'''Remove data from the original DATA Sheet from Gutter Machine Sheet where the Batch originated from
ThisWorkbook.Sheets("Gutter Machine Data").Rows("3:" & i - 1).Delete
'''WIRTE Zeros if No QTY/Length is present to enforce machine register START
Set ws = Sheets("Gutter Machine Batch")
For r = 4 To 14
If ws.Range("F" & r).Value = "" Then ws.Range("F" & r & ":G" & r) = "0"
Next r
'''Tell the machine the job has been loaded
Sheets("Gutter Machine Batch").Range("R3") = "1"
'Application.Wait (Now + TimeValue("0:00:05"))
End If
End If
'''MAGIC
If Sheets("Gutter Machine Batch").Range("AK3") = 1 Then
Sheets("Gutter Machine Batch").Range("R3") = 0
Sheets("Gutter Machine Batch").Range("AJ3") = 0
End If
Call LoadBarge
Application.ScreenUpdating = True
End Sub
Sub movecompletedGutter()
Application.ScreenUpdating = False
Dim ws As Worksheet, Lastrow As Long
Dim ws2 As Worksheet
Set ws = Sheets("Gutter Machine Batch")
''Move the job to daily recorded sheet
'ThisWorkbook.Sheets("Gutter Machine Batch").Range("B6").Value = ThisWorkbook.Sheets("Gutter Machine").Range("B6").Value ''AS B2 in Data sheet is always going to be current First in First out concept
For i = 4 To 50000 ''count how many lines for this job (as jobs will always be stacked together this is easy to find
If Not ThisWorkbook.Sheets("Gutter Machine Batch").Range("A" & i).Value = ThisWorkbook.Sheets("Gutter Machine Batch").Range("A3").Value Then
Exit For
End If
Next i
ws.Range("A3:AN" & i - 1).Copy
Set ws2 = Sheets("Gutter Job List")
Lastrow = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row + 1
'Coil Sheet
Sheets("Gutter Job List").Range("A" & Lastrow).PasteSpecial Paste:=xlPasteValues
'Sheets("Gutter").Range("A" & Cells(Rows.Count, "A").End(xlUp).Row).PasteSpecial Paste:=xlPasteValues
Call ClearGutterBatch
Application.ScreenUpdating = True
End Sub
Sub ClearGutterBatch()
Application.ScreenUpdating = False
Dim ws As Worksheet
Set ws = Sheets("Gutter Machine Batch")
With ws
For i = 4 To 50000 ''count how many lines for this job (as jobs will always be stacked together this is easy to find
If Not ThisWorkbook.Sheets("Gutter Machine Batch").Range("A" & i).Value = ThisWorkbook.Sheets("Gutter Machine Batch").Range("A3").Value Then
Exit For
End If
Next i
.Range("A3:CC" & i - 1).ClearContents
.Range("AJ3") = 4
End With
Call LoadGutter
Application.ScreenUpdating = True
End Sub
Sub LoadBarge()
Application.ScreenUpdating = False
Dim r As Long, ws As Worksheet
Dim wb As Workbook
Set wb = Workbooks("Best Shed Scheduler Flashing.xlsm")
'If Sheets("Barge Machine Batch").Range("R3") = 1 And Sheets("Barge Machine Batch").Range("AJ3") = 1 And Sheets("Barge Machine Batch").Range("AK3") = 0 Then
'Sheets("Barge Machine Batch").Range("R3") = 0
'Sheets("Barge Machine Batch").Range("AJ3") = 0
'End If
If Sheets("Barge Machine Batch").Range("N3") = 3 And Sheets("Barge Machine Batch").Range("P3").Value = 1 And Sheets("Barge Machine Batch").Range("AJ3") = 0 Then
Sheets("Barge Machine Batch").Range("AJ3") = 2
'''Job has been completed TIME STAMP
Sheets("Barge Machine Batch").Range("AN3").Value = Now
''Engage the move of completed Barge batch once completed triggers are found
Call movecompletedBarge
End If
''Run the Load''
If Sheets("Barge Machine Batch").Range("N3") = 3 And Sheets("Barge Machine Batch").Range("P3").Value = 1 And Sheets("Barge Machine Batch").Range("AJ3").Value = 4 Then
'If ActiveSheet.Range("N3").Value = "3" And ActiveSheet.Range("P3").Value = "1" And ActiveSheet.Range("AJ3") = "4" Then
'Sheets("Barge Machine Data").Select
'NEW SHORT CODE
If Sheets("Barge Machine Data").Range("A3") >= 1 Then
Sheets("Barge Machine Batch").Range("AJ3") = "1"
''Load next job
ThisWorkbook.Sheets("Barge Machine Batch").Range("B6").Value = ThisWorkbook.Sheets("Barge Machine Data").Range("A3").Value ''AS B2 in Data sheet is always going to be current First in First out concept
For i = 3 To 50000 ''count how many lines for this job (as jobs will always be stacked together this is easy to find
If Not ThisWorkbook.Sheets("Barge Machine Data").Range("A" & i).Value = ThisWorkbook.Sheets("Barge Machine Batch").Range("B6").Value Then
Exit For
End If
Next i
'''Need help with this section getting rid of selects - need it to jump between sheets but can't work out how to do it
Sheets("Barge Machine Data").Range("A3:Z" & i - 1).Copy
Sheets("Barge Machine Batch").Cells(3, 1).PasteSpecial Paste:=xlValues
''''TIME STAMP LOAD IN
Sheets("Barge Machine Batch").Range("AM3").Value = Now
'''Remove data from the original DATA Sheet from Barge Machine Sheet where the Batch originated from
ThisWorkbook.Sheets("Barge Machine Data").Rows("3:" & i - 1).Delete
'Workbook SAVE on LOAD JOB
'wb.Save
'''WIRTE Zeros if No QTY/Length is present to enforce machine register START
Set ws = Sheets("Barge Machine Batch")
For r = 4 To 14
If ws.Range("F" & r).Value = "" Then ws.Range("F" & r & ":G" & r) = "0"
Next r
'''Tell the machine the job has been loaded
Sheets("Barge Machine Batch").Range("R3") = "1"
'Application.Wait (Now + TimeValue("0:00:05"))
End If
End If
'''New code - test first
If Sheets("Barge Machine Batch").Range("AK3") = 1 Then
Sheets("Barge Machine Batch").Range("R3") = 0
Sheets("Barge Machine Batch").Range("AJ3") = 0
End If
Call LoadCornerFlashing
Application.ScreenUpdating = True
End Sub
Sub movecompletedBarge()
Application.ScreenUpdating = False
Dim ws As Worksheet, Lastrow As Long
Dim ws2 As Worksheet
Set ws = Sheets("Barge Machine Batch")
''Move the job to daily recorded sheet
'ThisWorkbook.Sheets("Barge Machine Batch").Range("B6").Value = ThisWorkbook.Sheets("Barge Machine").Range("B6").Value ''AS B2 in Data sheet is always going to be current First in First out concept
For i = 4 To 50000 ''count how many lines for this job (as jobs will always be stacked together this is easy to find
If Not ThisWorkbook.Sheets("Barge Machine Batch").Range("A" & i).Value = ThisWorkbook.Sheets("Barge Machine Batch").Range("A3").Value Then
Exit For
End If
Next i
ws.Range("A3:AN" & i - 1).Copy
Set ws2 = Sheets("Barge Job List")
Lastrow = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row + 1
Sheets("Barge Job List").Range("A" & Lastrow).PasteSpecial Paste:=xlPasteValues
'Sheets("Barge").Range("A" & Cells(Rows.Count, "A").End(xlUp).Row).PasteSpecial Paste:=xlPasteValues
Call ClearBargeBatch
Application.ScreenUpdating = True
End Sub
Sub ClearBargeBatch()
Application.ScreenUpdating = False
Dim ws As Worksheet
Set ws = Sheets("Barge Machine Batch")
With ws
For i = 4 To 50000 ''count how many lines for this job (as jobs will always be stacked together this is easy to find
If Not ThisWorkbook.Sheets("Barge Machine Batch").Range("A" & i).Value = ThisWorkbook.Sheets("Barge Machine Batch").Range("A3").Value Then
Exit For
End If
Next i
.Range("A3:CC" & i - 1).ClearContents
.Range("AJ3") = 4
End With
Call LoadBarge
Application.ScreenUpdating = True
End Sub
Sub LoadCornerFlashing()
Application.ScreenUpdating = False
Dim r As Long, ws As Worksheet
Dim wb As Workbook
Set wb = Workbooks("Best Shed Scheduler Flashing.xlsm")
Dim WshNetwork
'If Sheets("Corner Flashing Machine Batch").Range("R3") = 1 And Sheets("Corner Flashing Machine Batch").Range("AJ3") = 1 And Sheets("Corner Flashing Machine Batch").Range("AK3") = 0 Then
'Sheets("Corner Flashing Machine Batch").Range("R3") = 0
'Sheets("Corner Flashing Machine Batch").Range("AJ3") = 0
'End If
If Sheets("Corner Flashing Machine Batch").Range("N3") = 3 And Sheets("Corner Flashing Machine Batch").Range("P3").Value = 1 And Sheets("Corner Flashing Machine Batch").Range("AJ3") = 0 Then
Sheets("Corner Flashing Machine Batch").Range("AJ3") = 2
'''Job has been completed TIME STAMP
Sheets("Corner Flashing Machine Batch").Range("AN3").Value = Now
''Engage the move of completed Corner Flashing batch once completed triggers are found
Call movecompletedcornerflashing
End If
''Run the Load''
If Sheets("Corner Flashing Machine Batch").Range("N3") = 3 And Sheets("Corner Flashing Machine Batch").Range("P3").Value = 1 And Sheets("Corner Flashing Machine Batch").Range("AJ3").Value = 4 Then
'NEW SHORT CODE
If Sheets("Corner Flashing Machine Data").Range("A3") >= 1 Then
Sheets("Corner Flashing Machine Batch").Range("AJ3") = "1"
''Load next job
ThisWorkbook.Sheets("Corner Flashing Machine Batch").Range("B6").Value = ThisWorkbook.Sheets("Corner Flashing Machine Data").Range("A3").Value ''AS B2 in Data sheet is always going to be current First in First out concept
For i = 3 To 50000 ''count how many lines for this job (as jobs will always be stacked together this is easy to find
If Not ThisWorkbook.Sheets("Corner Flashing Machine Data").Range("A" & i).Value = ThisWorkbook.Sheets("Corner Flashing Machine Batch").Range("B6").Value Then
Exit For
End If
Next i
'''Need help with this section getting rid of selects - need it to jump between sheets but can't work out how to do it
Sheets("Corner Flashing Machine Data").Range("A3:Z" & i - 1).Copy
Sheets("Corner Flashing Machine Batch").Cells(3, 1).PasteSpecial Paste:=xlValues
''''TIME STAMP LOAD IN
Sheets("Corner Flashing Machine Batch").Range("AM3").Value = Now
''''Print Label
Set ws = Sheets("Corner Label")
Set WshNetwork = CreateObject("WScript.Network")
Sheets("Corner Label").PrintOut ActivePrinter:="Corner Flashing Label"
'''Remove data from the original DATA Sheet from Corner Flashing Machine Sheet where the Batch originated from
ThisWorkbook.Sheets("Corner Flashing Machine Data").Rows("3:" & i - 1).Delete
'''WIRTE Zeros if No QTY/Length is present to enforce machine register START
Set ws = Sheets("Corner Flashing Machine Batch")
For r = 4 To 14
If ws.Range("F" & r).Value = "" Then ws.Range("F" & r & ":G" & r) = "0"
Next r
'''Tell the machine the job has been loaded
Sheets("Corner Flashing Machine Batch").Range("R3") = "1"
'Application.Wait (Now + TimeValue("0:00:05"))
End If
End If
'''New code - test first
If Sheets("Corner Flashing Machine Batch").Range("AK3") = 1 Then
Sheets("Corner Flashing Machine Batch").Range("R3") = 0
Sheets("Corner Flashing Machine Batch").Range("AJ3") = 0
End If
Call LoadRidge300
Application.ScreenUpdating = True
End Sub
Sub movecompletedcornerflashing()
Application.ScreenUpdating = False
Dim ws As Worksheet, Lastrow As Long
Dim ws2 As Worksheet
Set ws = Sheets("Corner Flashing Machine Batch")
''Move the job to daily recorded sheet
'ThisWorkbook.Sheets("Corner FlashingMachine Batch").Range("B6").Value = ThisWorkbook.Sheets("Corner FlashingMachine").Range("B6").Value ''AS B2 in Data sheet is always going to be current First in First out concept
For i = 4 To 50000 ''count how many lines for this job (as jobs will always be stacked together this is easy to find
If Not ThisWorkbook.Sheets("Corner Flashing Machine Batch").Range("A" & i).Value = ThisWorkbook.Sheets("Corner Flashing Machine Batch").Range("A3").Value Then
Exit For
End If
Next i
ws.Range("A3:AN" & i - 1).Copy
Set ws2 = Sheets("Corner Flashing Job List")
Lastrow = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row + 1
Sheets("Corner Flashing Job List").Range("A" & Lastrow).PasteSpecial Paste:=xlPasteValues
'Sheets("Gutter").Range("A" & Cells(Rows.Count, "A").End(xlUp).Row).PasteSpecial Paste:=xlPasteValues
Call ClearCornerFlashingBatch
Application.ScreenUpdating = True
End Sub
Sub ClearCornerFlashingBatch()
Application.ScreenUpdating = False
Dim ws As Worksheet
Set ws = Sheets("Corner Flashing Machine Batch")
With ws
For i = 4 To 50000 ''count how many lines for this job (as jobs will always be stacked together this is easy to find
If Not ThisWorkbook.Sheets("Corner Flashing Machine Batch").Range("A" & i).Value = ThisWorkbook.Sheets("Corner Flashing Machine Batch").Range("A3").Value Then
Exit For
End If
Next i
.Range("A3:CC" & i - 1).ClearContents
.Range("AJ3") = 4
End With
Call LoadCornerFlashing
Application.ScreenUpdating = True
End Sub
Sub LoadRidge300()
Application.ScreenUpdating = False
Dim r As Long, ws As Worksheet
Dim wb As Workbook
Set wb = Workbooks("Best Shed Scheduler Flashing.xlsm")
Dim WshNetwork
'If Sheets("Ridge 300 Machine Batch").Range("R3") = 1 And Sheets("Ridge 300 Machine Batch").Range("AJ3") = 1 And Sheets("Ridge 300 Machine Batch").Range("AK3") = 0 Then
'Sheets("Ridge 300 Machine Batch").Range("R3") = 0
'Sheets("Ridge 300 Machine Batch").Range("AJ3") = 0
'End If
If Sheets("Ridge 300 Machine Batch").Range("N3") = 3 And Sheets("Ridge 300 Machine Batch").Range("P3").Value = 1 And Sheets("Ridge 300 Machine Batch").Range("AJ3") = 0 Then
Sheets("Ridge 300 Machine Batch").Range("AJ3") = 2
ActiveWorkbook.Save
'''Job has been completed TIME STAMP
Sheets("Ridge 300 Machine Batch").Range("AN3").Value = Now
''Engage the move of completed Ridge 300 batch once completed triggers are found
Call movecompletedridge300
End If
''Run the Load''
If Sheets("Ridge 300 Machine Batch").Range("N3") = 3 And Sheets("Ridge 300 Machine Batch").Range("P3").Value = 1 And Sheets("Ridge 300 Machine Batch").Range("AJ3").Value = 4 Then
'NEW SHORT CODE
If Sheets("Ridge 300 Machine Data").Range("A3") >= 1 Then
Sheets("Ridge 300 Machine Batch").Range("AJ3") = "1"
''Load next job
ThisWorkbook.Sheets("Ridge 300 Machine Batch").Range("B6").Value = ThisWorkbook.Sheets("Ridge 300 Machine Data").Range("A3").Value ''AS B2 in Data sheet is always going to be current First in First out concept
For i = 3 To 50000 ''count how many lines for this job (as jobs will always be stacked together this is easy to find
If Not ThisWorkbook.Sheets("Ridge 300 Machine Data").Range("A" & i).Value = ThisWorkbook.Sheets("Ridge 300 Machine Batch").Range("B6").Value Then
Exit For
End If
Next i
'''Need help with this section getting rid of selects - need it to jump between sheets but can't work out how to do it
Sheets("Ridge 300 Machine Data").Range("A3:Z" & i - 1).Copy
Sheets("Ridge 300 Machine Batch").Cells(3, 1).PasteSpecial Paste:=xlValues
''''TIME STAMP LOAD IN
Sheets("Ridge 300 Machine Batch").Range("AM3").Value = Now
'''Remove data from the original DATA Sheet from Ridge 300 Machine Sheet where the Batch originated from
ThisWorkbook.Sheets("Ridge 300 Machine Data").Rows("3:" & i - 1).Delete
'Print Label
Set ws = Sheets("Ridge300 Label")
Set WshNetwork = CreateObject("WScript.Network")
Sheets("Ridge300 Label").PrintOut ActivePrinter:="Ridge300 Label"
'''WIRTE Zeros if No QTY/Length is present to enforce machine register START
Set ws = Sheets("Ridge 300 Machine Batch")
For r = 4 To 14
If ws.Range("F" & r).Value = "" Then ws.Range("F" & r & ":G" & r) = "0"
Next r
'''Tell the machine the job has been loaded
Sheets("Ridge 300 Machine Batch").Range("R3") = "1"
'Application.Wait (Now + TimeValue("0:00:05"))
End If
End If
'''New code - test first
If Sheets("Ridge 300 Machine Batch").Range("AK3") = 1 Then
Sheets("Ridge 300 Machine Batch").Range("R3") = 0
Sheets("Ridge 300 Machine Batch").Range("AJ3") = 0
End If
Call LoadRidge400
Application.ScreenUpdating = True
End Sub
Sub movecompletedridge300()
Application.ScreenUpdating = False
Dim ws As Worksheet, Lastrow As Long
Dim ws2 As Worksheet
Set ws = Sheets("Ridge 300 Machine Batch")
''Move the job to daily recorded sheet
'ThisWorkbook.Sheets("Ridge 300Machine Batch").Range("B6").Value = ThisWorkbook.Sheets("Ridge 300Machine").Range("B6").Value ''AS B2 in Data sheet is always going to be current First in First out concept
For i = 4 To 50000 ''count how many lines for this job (as jobs will always be stacked together this is easy to find
If Not ThisWorkbook.Sheets("Ridge 300 Machine Batch").Range("A" & i).Value = ThisWorkbook.Sheets("Ridge 300 Machine Batch").Range("A3").Value Then
Exit For
End If
Next i
ws.Range("A3:AN" & i - 1).Copy
Set ws2 = Sheets("Ridge300 Job List")
Lastrow = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row + 1
Sheets("Ridge300 Job List").Range("A" & Lastrow).PasteSpecial Paste:=xlPasteValues
'Sheets("Gutter").Range("A" & Cells(Rows.Count, "A").End(xlUp).Row).PasteSpecial Paste:=xlPasteValues
Call ClearRidge300
Application.ScreenUpdating = True
End Sub
Sub ClearRidge300()
Application.ScreenUpdating = False
Dim ws As Worksheet
Set ws = Sheets("Ridge 300 Machine Batch")
With ws
For i = 4 To 50000 ''count how many lines for this job (as jobs will always be stacked together this is easy to find
If Not ThisWorkbook.Sheets("Ridge 300 Machine Batch").Range("A" & i).Value = ThisWorkbook.Sheets("Ridge 300 Machine Batch").Range("A3").Value Then
Exit For
End If
Next i
.Range("A3:CC" & i - 1).ClearContents
.Range("AJ3") = 4
End With
Call LoadRidge300
Application.ScreenUpdating = True
End Sub
Sub LoadRidge400()
Application.ScreenUpdating = False
Dim WshNetwork
Dim r As Long, ws As Worksheet
Dim wb As Workbook
Set wb = Workbooks("Best Shed Scheduler Flashing.xlsm")
'If Sheets("Ridge 400 Machine Batch").Range("R3") = 1 And Sheets("Ridge 400 Machine Batch").Range("AJ3") = 1 And Sheets("Ridge 400 Machine Batch").Range("AK3") = 0 Then
'Sheets("Ridge 400 Machine Batch").Range("R3") = 0
'Sheets("Ridge 400 Machine Batch").Range("AJ3") = 0
'End If
If Sheets("Ridge 400 Machine Batch").Range("N3") = 3 And Sheets("Ridge 400 Machine Batch").Range("P3").Value = 1 And Sheets("Ridge 400 Machine Batch").Range("AJ3") = 0 Then
Sheets("Ridge 400 Machine Batch").Range("AJ3") = 2
ActiveWorkbook.Save
'''Job has been completed TIME STAMP
Range("AN3").Value = Now
''Engage the move of completed Ridge 400 batch once completed triggers are found
Call movecompletedRidge400
End If
''Run the Load''
If Sheets("Ridge 400 Machine Batch").Range("N3") = 3 And Sheets("Ridge 400 Machine Batch").Range("P3").Value = 1 And Sheets("Ridge 400 Machine Batch").Range("AJ3").Value = 4 Then
'NEW SHORT CODE
If Sheets("Ridge 400 Machine Data").Range("A3") >= 1 Then
Sheets("Ridge 400 Machine Batch").Range("AJ3") = "1"
''Load next job
ThisWorkbook.Sheets("Ridge 400 Machine Batch").Range("B6").Value = ThisWorkbook.Sheets("Ridge 400 Machine Data").Range("A3").Value ''AS B2 in Data sheet is always going to be current First in First out concept
For i = 3 To 50000 ''count how many lines for this job (as jobs will always be stacked together this is easy to find
If Not ThisWorkbook.Sheets("Ridge 400 Machine Data").Range("A" & i).Value = ThisWorkbook.Sheets("Ridge 400 Machine Batch").Range("B6").Value Then
Exit For
End If
Next i
'''Need help with this section getting rid of selects - need it to jump between sheets but can't work out how to do it
Sheets("Ridge 400 Machine Data").Range("A3:Z" & i - 1).Copy
Sheets("Ridge 400 Machine Batch").Cells(3, 1).PasteSpecial Paste:=xlValues
''''TIME STAMP LOAD IN
Sheets("Ridge 400 Machine Batch").Range("AM3").Value = Now
'Print
Set ws = Sheets("Ridge400 Label")
Set WshNetwork = CreateObject("WScript.Network")
Sheets("Ridge400 Label").PrintOut ActivePrinter:="Ridge400 Label"
'''Remove data from the original DATA Sheet from Ridge 400 Machine Sheet where the Batch originated from
ThisWorkbook.Sheets("Ridge 400 Machine Data").Rows("3:" & i - 1).Delete
'''WIRTE Zeros if No QTY/Length is present to enforce machine register START
Set ws = Sheets("Ridge 400 Machine Batch")
For r = 4 To 14
If ws.Range("F" & r).Value = "" Then ws.Range("F" & r & ":G" & r) = "0"
Next r
'''Tell the machine the job has been loaded
Sheets("Ridge 400 Machine Batch").Range("R3") = "1"
'Application.Wait (Now + TimeValue("0:00:05"))
End If
End If
'''New code - test first
If Sheets("Ridge 400 Machine Batch").Range("AK3") = 1 Then
Sheets("Ridge 400 Machine Batch").Range("R3") = 0
Sheets("Ridge 400 Machine Batch").Range("AJ3") = 0
End If
Call CheckCoilDownpipe
Application.ScreenUpdating = True
End Sub
Sub movecompletedRidge400()
Application.ScreenUpdating = False
Dim ws As Worksheet, Lastrow As Long
Dim ws2 As Worksheet
Set ws = Sheets("Ridge 400 Machine Batch")
''Move the job to daily recorded sheet
'ThisWorkbook.Sheets("Ridge 400Machine Batch").Range("B6").Value = ThisWorkbook.Sheets("Ridge 400Machine").Range("B6").Value ''AS B2 in Data sheet is always going to be current First in First out concept
For i = 4 To 50000 ''count how many lines for this job (as jobs will always be stacked together this is easy to find
If Not ThisWorkbook.Sheets("Ridge 400 Machine Batch").Range("A" & i).Value = ThisWorkbook.Sheets("Ridge 400 Machine Batch").Range("A3").Value Then
Exit For
End If
Next i
ws.Range("A3:AN" & i - 1).Copy
Set ws2 = Sheets("Ridge400 Job List")
Lastrow = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row + 1
Sheets("Ridge400 Job List").Range("A" & Lastrow).PasteSpecial Paste:=xlPasteValues
'Sheets("Gutter").Range("A" & Cells(Rows.Count, "A").End(xlUp).Row).PasteSpecial Paste:=xlPasteValues
Call ClearRidge400
Application.ScreenUpdating = True
End Sub
Sub ClearRidge400()
Application.ScreenUpdating = False
Dim ws As Worksheet
Set ws = Sheets("Ridge 400 Machine Batch")
With ws
For i = 4 To 50000 ''count how many lines for this job (as jobs will always be stacked together this is easy to find
If Not ThisWorkbook.Sheets("Ridge 400 Machine Batch").Range("A" & i).Value = ThisWorkbook.Sheets("Ridge 400 Machine Batch").Range("A3").Value Then
Exit For
End If
Next i
.Range("A3:CC" & i - 1).ClearContents
.Range("AJ3") = 4
End With
Call LoadRidge400
Application.ScreenUpdating = True
End Sub
Sub CheckCoilDownpipe()
Application.ScreenUpdating = False
Dim ws As Worksheet, Lastrow As Long
Dim ws2 As Worksheet
Set ws = Sheets("Downpipe Machine Batch")
If Sheets("Downpipe Machine Batch").Range("AP3") = 0 And Sheets("Downpipe Machine Batch").Range("AQ3") = 1 Then
Sheets("Downpipe Machine Batch").Range("AQ3") = 0
End If
If Sheets("Downpipe Machine Batch").Range("AP3") = 1 And Sheets("Downpipe Machine Batch").Range("AQ3") = 0 Then
ws.Range("AR3:AZ26").Copy
Set ws2 = Sheets("Downpipe Job List")
Lastrow = ws2.Cells(ws2.Rows.Count, "AS").End(xlUp).Row + 1
Sheets("Downpipe Job List").Range("AR" & Lastrow).PasteSpecial Paste:=xlPasteValues
Sheets("Downpipe Machine Batch").Range("AQ3") = 1
End If
Call CheckCoilRidge300
Application.ScreenUpdating = True
End Sub
Sub CheckCoilRidge300()
Application.ScreenUpdating = False
Dim ws As Worksheet, Lastrow As Long
Dim ws2 As Worksheet
Set ws = Sheets("Ridge 300 Machine Batch")
If Sheets("Ridge 300 Machine Batch").Range("AP3") = 0 And Sheets("Ridge 300 Machine Batch").Range("AQ3") = 1 Then
Sheets("Ridge 300 Machine Batch").Range("AQ3") = 0
End If
If Sheets("Ridge 300 Machine Batch").Range("AP3") = 1 And Sheets("Ridge 300 Machine Batch").Range("AQ3") = 0 Then
ws.Range("AR3:AZ26").Copy
Set ws2 = Sheets("Ridge300 Job List")
Lastrow = ws2.Cells(ws2.Rows.Count, "AS").End(xlUp).Row + 1
Sheets("Ridge300 Job List").Range("AR" & Lastrow).PasteSpecial Paste:=xlPasteValues
Sheets("Ridge 300 Machine Batch").Range("AQ3") = 1
End If
Call CheckCoilRidge400
Application.ScreenUpdating = True
End Sub
Sub CheckCoilRidge400()
Application.ScreenUpdating = False
Dim ws As Worksheet, Lastrow As Long
Dim ws2 As Worksheet
Set ws = Sheets("Ridge 400 Machine Batch")
If Sheets("Ridge 400 Machine Batch").Range("AP3") = 0 And Sheets("Ridge 400 Machine Batch").Range("AQ3") = 1 Then
Sheets("Ridge 400 Machine Batch").Range("AQ3") = 0
End If
If Sheets("Ridge 400 Machine Batch").Range("AP3") = 1 And Sheets("Ridge 400 Machine Batch").Range("AQ3") = 0 Then
ws.Range("AR3:AZ26").Copy
Set ws2 = Sheets("Ridge400 Job List")
Lastrow = ws2.Cells(ws2.Rows.Count, "AS").End(xlUp).Row + 1
Sheets("Ridge400 Job List").Range("AR" & Lastrow).PasteSpecial Paste:=xlPasteValues
Sheets("Ridge 400 Machine Batch").Range("AQ3") = 1
End If
Call CheckCoilCorner
Application.ScreenUpdating = True
End Sub
Sub CheckCoilCorner()
Application.ScreenUpdating = False
Dim ws As Worksheet, Lastrow As Long
Dim ws2 As Worksheet
Set ws = Sheets("Corner Flashing Machine Batch")
If Sheets("Corner Flashing Machine Batch").Range("AP3") = 0 And Sheets("Corner Flashing Machine Batch").Range("AQ3") = 1 Then
Sheets("Corner Flashing Machine Batch").Range("AQ3") = 0
End If
If Sheets("Corner Flashing Machine Batch").Range("AP3") = 1 And Sheets("Corner Flashing Machine Batch").Range("AQ3") = 0 Then
ws.Range("AR3:AZ26").Copy
Set ws2 = Sheets("Corner Flashing Job List")
Lastrow = ws2.Cells(ws2.Rows.Count, "AS").End(xlUp).Row + 1
Sheets("Corner Flashing Job List").Range("AR" & Lastrow).PasteSpecial Paste:=xlPasteValues
Sheets("Corner Flashing Machine Batch").Range("AQ3") = 1
End If
Call CheckCoilBarge
Application.ScreenUpdating = True
End Sub
Sub CheckCoilBarge()
Application.ScreenUpdating = False
Dim ws As Worksheet, Lastrow As Long
Dim ws2 As Worksheet
Set ws = Sheets("Barge Machine Batch")
If Sheets("Barge Machine Batch").Range("AP3") = 0 And Sheets("Barge Machine Batch").Range("AQ3") = 1 Then
Sheets("Barge Machine Batch").Range("AQ3") = 0
End If
If Sheets("Barge Machine Batch").Range("AP3") = 1 And Sheets("Barge Machine Batch").Range("AQ3") = 0 Then
ws.Range("AR3:AZ26").Copy
Set ws2 = Sheets("Barge Job List")
Lastrow = ws2.Cells(ws2.Rows.Count, "AS").End(xlUp).Row + 1
Sheets("Barge Job List").Range("AR" & Lastrow).PasteSpecial Paste:=xlPasteValues
Sheets("Barge Machine Batch").Range("AQ3") = 1
End If
Call CheckCoilGutter
Application.ScreenUpdating = True
End Sub
Sub CheckCoilGutter()
Application.ScreenUpdating = False
Dim ws As Worksheet, Lastrow As Long
Dim ws2 As Worksheet
Set ws = Sheets("Gutter Machine Batch")
If Sheets("Gutter Machine Batch").Range("AP3") = 0 And Sheets("Gutter Machine Batch").Range("AQ3") = 1 Then
Sheets("Gutter Machine Batch").Range("AQ3") = 0
End If
If Sheets("Gutter Machine Batch").Range("AP3") = 1 And Sheets("Gutter Machine Batch").Range("AQ3") = 0 Then
ws.Range("AR3:AZ26").Copy
Set ws2 = Sheets("Gutter Job List")
Lastrow = ws2.Cells(ws2.Rows.Count, "AS").End(xlUp).Row + 1
Sheets("Gutter Job List").Range("AR" & Lastrow).PasteSpecial Paste:=xlPasteValues
Sheets("Gutter Machine Batch").Range("AQ3") = 1
End If
Application.ScreenUpdating = True
Call Timercontrol
End Sub