Vba Clean Up

[Lukums]

Hello guys,

At my wits end.

I've posted this before but cleaned it up. We run this sub 24 hrs a day on a 10-15 second loop. We have had to restart this twice during operations per day this week (which is obviously bad).

The sub contains 6 machines however, I've only put one here for the example as the others are coded the exact same way word for word, line for line.

I understand that time is precious, if this is a big job (and stop me where I'm against rules) We are happy to pay someone for assistance until resolved.

For the time being... can anyone see why this is going into a "Not responding state" over a 4-5 hr period.

Happy to provide the actual workbook if required.

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
        Range("E7").Value = "ONLINE"
    Call Timercontrol
        Case vbNo
        GoTo Quit:
    End Select
Application.ScreenUpdating = True
Quit:
End Sub


Sub STOPAUTOMATION()
Application.ScreenUpdating = False
Range("E7").Value = "OFFLINE"
Range("A1").Value = "1"
ActiveWorkbook.Save
If Range("A1").Value = "1" Then Call EXITAUTO
Exit Sub
Application.ScreenUpdating = True
End Sub


Sub Timercontrol()
On Error Resume Next
Application.ScreenUpdating = False
    If Sheets("HOME").Range("E7").Value = "ONLINE" Then
    TimeToRun = Now + TimeValue("00:00:15")
    Application.OnTime TimeToRun, "LoadDownpipe"
    Else
    Exit Sub
    End If
    On Error GoTo 0
Application.ScreenUpdating = True
End Sub
Sub LoadDownpipe()
On Error Resume Next
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("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
                'ActiveWorkbook.Save
                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
        
                    'new line of code 18/02/2019 - removal of the copy/paste
                    Sheets("Downpipe Machine Batch").Range("A3:H" & i - 1).Value = Sheets("Downpipe Machine Data").Range("A3:H" & i - 1).Value
                                                                                                                                                                                          
                ''''TIME STAMP LOAD IN
                Sheets("Downpipe Machine Batch").Range("AM3").Value = Now
                
                'Set ws = Sheets("Downpipe Label")
                'Set WshNetwork = CreateObject("WScript.Network")
                'Sheets("Downpipe Label").PrintOut ActivePrinter:="Ridge400 Label"
                                                                                                
                '''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
                            'Awaiting BIT control to clear values
                            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
            
    On Error GoTo 0


    ''Going back to timer however there are 6 (other subs) exactly written the same way which is called here (due to length of code) only included 1 sub of this.
Call Timercontrol
Application.ScreenUpdating = True
End Sub

Luke

 

[mole999]

If you want to pay then contact Excel Consulting Services at the top of each page and discus there

 

[Logit]

.
My 2 cents for whatever it is worth. (Probably not much).

Almost all of these suggestions were derived from various Excel / Microsoft websites - with the exception of the last one which is personal experience.
If your code runs 99% of the time without issue, it probably isn't the code syntax (my view).

Here are a number of suggestions :

Start Excel in SAFE MODE.
Run the program and see if the issue occurs again.
If it doesn't, try disabling any add-ins to Excel.


Disable all Add-Ins to Excel.


Change the DEFAULT PRINTER.
This method seems irrelevant but it is not. As, whenever the user opens an Excel
Spreadsheet then it internally tries to communicate with the connected Printers
to check for the compatible margins.

Recompile Macros
Open the MS Excel and then navigate to the Developer –> Visual Basic.

Go to the Tools -> Options. After opening the Options window click on the General tab
and clear the ‘Compile VBA’. Syntax issues will be revealed.


Repair Excel


Re-Install Microsoft Office


Update or Disable Anti-Virus Software


Turn off Application.Calculation = xlAutomatic at beginning of macros
Whenever you update a cell, Excel goes through a process to recalculate the workbook.
When working directly within Excel you want this to happen 99.9% of the time (the exception
being if you are working with an extremely large workbook). However, this can really slow
down your VBA code. It’s a good practice to set your calculations to manual at the begining
of macros and restore calculations at the end of macros. If you need to recalculate the
workbook you can manually tell Excel to calculate.

Application.ScreenUpdating = False
    Application.Calculation = xlManual


    'Your macro code


    Application.Calculatino = xlAutomatic
    Application.ScreenUpdating = True

Using DoEvents
At the beginning of a Loop / End Loop, use DoEvents

Loop
DoEvents
'Your code
End Loop



Workbook Corruption
From personal experience .. sometimes the Excel file becomes corrupt requiring
a "re-write" of the code to delete the corruption. I have had good success by:


Copying the macro to Notepad.
Re-create the sheet involved with the macro.
Copy/Paste the macro back into the Sheet Module of the re-created sheet.

Do the same with the Regular Modules. Copy / Paste macro to Notepad.
Delete the Module. Recreate the module. Paste macro back in.