VBA Not Responding - but...a solution

L

Lukums

Board Regular
Joined
Nov 23, 2015
Messages
195
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?

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
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
Sort by date Sort by votes
=ODIN= said:
Any idea which line(s) it crashes on usually?
Click to expand...

I wish! - It's really spontaneous.

I have 3 other alterations of this (almost exact same code) and they run 24/7 literally for weeks at a time on a never ending loop (by design).

This one has much more of the same (code) as you can see most of the subs repeat for difference machines.

All I can gather is Excel doesn't crash it kind of just pauses in a not responding state for a brief second and then attempts to run again.
So to fix this all I did was tell people if it happens. Stop and hit the "Restart button" which is just a JPEG with excel telling VBA "Stop" and then hit "Go" or "STart" another JPEG image.

It's a pain...
Could it be resources? Maybe... Could it be clipboard? Maybe... but doesn't explain why after stopping/restarting the routine it will work for the next 4 hours fine (timing is not exact either)
 
Upvote 0
Does it happen on ALL machines ??
Have you tried extending the loop to say 30 secs and see if that resolves the problem ?
Have you tried setting calculations to Manual at the beginning of the sub and back to Automatic at the end of the sub ?
 
Upvote 0
Lukums said:
Code: 
Public v As Integer

Sub 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
[B][COLOR="#FF0000"]Application.ScreenUpdating = True[/COLOR][/B]
Quit:
End Sub
[/QUOTE]
I would think you have way too much code for anyone to want to sit down and digest (I hope I am wrong for your sake), so I am not sure you will get the answer you seek. However, the above part of the code you posted does have a potential problem just waiting to happen. If anyone answers No to your MsgBox, their Excel worksheet will appear to freeze. The solution is to move the highlighted line of code from before the Quit label to after it.
Click to expand...
 
Upvote 0
Michael M said:
Does it happen on ALL machines ??
Have you tried extending the loop to say 30 secs and see if that resolves the problem ?
Have you tried setting calculations to Manual at the beginning of the sub and back to Automatic at the end of the sub ?
Click to expand...


Afternoon Michael,

Thanks for popping in once again.

So I have tried 30 seconds - same result - tried 4 seconds - same result.

I was thinking about doing exactly that setting to manual. Which I mean it's 100% worth a try.

The issue that I believe is that this is 1 version of the program (which has 6 machines and "does stuff" copy/pastes mostly with a few clears here and there) however these jobs move every 60 seconds per machine.
The other literation of the exact same code (almost word for word) - because it does the same thing has only 2 machines but these "do stuff" every 15-25minutes.

As you can see there is a MASSIVE difference in this fact alone.
I'm really leaning towards memory or something getting (full) as stopping and quickly restarting the code makes this issue go away which it is then fine for hours and hours until "something" causes it to hang.
 
Upvote 0
Rick Rothstein said:
I would think you have way too much code for anyone to want to sit down and digest (I hope I am wrong for your sake), so I am not sure you will get the answer you seek. However, the above part of the code you posted does have a potential problem just waiting to happen. If anyone answers No to your MsgBox, their Excel worksheet will appear to freeze. The solution is to move the highlighted line of code from before the Quit label to after it.
Click to expand...

Thank you for that catch will change immediately this is one issue - but not a major as if they do click no. They just re-click it (tested seems fine)

However - you're right with the amount of code however it's the same code repeated 6 times code pasted below once - no longer 6 machines calling one after another.

Code: 
[COLOR=#333333]Public v As IntegerSub BeginAutomation()[/COLOR]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


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  (NEXT MACHINE) - removed for repetition (same exact code have stepped through this)

Call TimerControl

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 Timer Control
Application.ScreenUpdating = True [COLOR=#333333]End Sub[/COLOR]
 
Upvote 0
It’s tough to debug something like this without having more of an idea of the situation at the time of crash.

A couple things that might be tried:
1. Setup a log file that you periodically write to throughout your code... write time stamps and and files being processed and sectio. Of code being executed. Hopefully with some good logging you’ll be able to narrow down the situation when it crashes. Or see some pattern...

2. Try making sure to do some variables cleanup throughout your code. If you set an object variable. Try explicitly setting it to = nothing when you are finished with it. Might help with memory issues.
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
Copying Filtered Columns (non-adjacent) from one Table to end of another, but need to also add information in adjacent column of Destination Table
Replies
1
Views
581
sspatriots
S
lojanica
  • Question Question
How to execute VBA every 10 minutes?
2 3 4
Replies
33
Views
433
Logit
Logit
S
  • Solved
Run-time error '1004': No cells were found.
Replies
4
Views
1K
sspatriots
S
K
  • Solved
Code to search job id from multiple sources and update main spreadsheet.
2
Replies
10
Views
681
mumps
mumps
R
  • Solved
VBA: Merging rows after a particular row, based off of matching entries in column
2
Replies
19
Views
967
Georgiboy
Georgiboy

Forum statistics

Threads
1,224,823
Messages
6,181,177
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top