Vba Clean Up


Board Regular
Nov 23, 2015
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
End Sub

Application.ScreenUpdating = False
Range("E7").Value = "OFFLINE"
Range("A1").Value = "1"
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"
    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
                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


Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
If you want to pay then contact Excel Consulting Services at the top of each page and discus there
Upvote 0
My 2 cents for whatever it is worth. (Probably not much). :LOL:

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.

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

'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.
Last edited:
Upvote 0

Forum statistics

Latest member

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