Nasty, Ugly Code - Requires a Trim

Lukums · Sep 14, 2018

G'day guys -

I have the code below: I have 3 virtual machines. 2 virtual machines with the same code runs fine (however only 3 subs are on these two).

The below speaks to 6 pieces of roll formers in our factory and does run well (most days), I've been experiencing issues in relation to it just crashing randomly. The code can sometimes work for days even up to a week on an indefinite loop (by design) it needs to loop to each machine constantly within 8 seconds to determine to move next batches in.

However the code is ugly as hell, I'm just after tips or pointers or what may be causing memory leaks:

Will only post 1 machine (the others are the exact same code) as it calls one another.

Code:

Sub Timercontrol()

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
'' Keep in mind MITSUBIHI takes 2 seconds to run it's side '' so 2+ your TIMETORUN value is the turn around time for new job load
    TimeToRun = Now + TimeValue("00:00:08")
    
    If v = 1 Then
    Exit Sub
    End If
    
    
    If v = 0 Then
        'TimeToRun = Now + TimeValue("00:00:07")
            Application.OnTime TimeToRun, "LoadDownpipe"
    End If
          
    End Sub
    


Sub LoadDownpipe()


    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
                ''' LOAD JOB from Machine DATA sheet
                ThisWorkbook.Sheets("Downpipe Machine Batch").Activate
                
                'N3 = 3 Batch Completed
                'P3 = 1 Opperator is ready for next job
                'AJ3 = 2 Unique flag multi jobs won't move this way
                               
                If ActiveSheet.Range("N3").Value = "3" And ActiveSheet.Range("P3").Value = "1" And ActiveSheet.Range("AJ3").Value = "0" Then
                                
                'Unique Value flag don't shift haven't recieved grant's magic
                ActiveSheet.Range("AJ3") = "2"
                
                '''Job has been completed TIME STAMP
                
                Range("AN3").Value = Now
                
                ''Engage the move of completed downpipe batch once completed triggers are found
                
                Call movecompleteddownpipe
                
                End If


                '''''''''''''''''
                ''Run the Load''
                ''Upon STARTUP you need to write the 0 to each machine to ensure the fresh load.
                ''One shot trigger the job'' to ensure no double load (BATCH QTY/LENGTH)
                '''''''''''''''''
                                                
                If ActiveSheet.Range("N3").Value = "3" And ActiveSheet.Range("P3").Value = "1" And ActiveSheet.Range("AJ3") = "4" Then
                Sheets("Downpipe Machine Data").Select
                If Range("A3") >= 1 Then
                Sheets("Downpipe Machine Batch").Activate
                ActiveSheet.Range("AJ3") = "3"
                
                '''''''''''''''''
                ''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
                
                            Sheets("Downpipe Machine Data").Select  ''copy data to main menu page
                            ThisWorkbook.Sheets("Downpipe Machine Data").Range("A3:Z" & i - 1).Select
                            Selection.Copy
                            Sheets("Downpipe Machine Batch").Select
                            ThisWorkbook.Sheets("Downpipe Machine Batch").Cells(3, 1).Select
                            Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
                            False, Transpose:=False
                            
                'Finished loading the Downpipe JOB
                
                ''''TIME STAMP LOAD IN
                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
                
                If ThisWorkbook.Sheets("Downpipe Machine Batch").Range("F4").Value = "" Then
                ThisWorkbook.Sheets("Downpipe Machine Batch").Range("F4:G4") = "0"
                End If
                If ThisWorkbook.Sheets("Downpipe Machine Batch").Range("F5").Value = "" Then
                ThisWorkbook.Sheets("Downpipe Machine Batch").Range("F5:G5") = "0"
                End If
                If ThisWorkbook.Sheets("Downpipe Machine Batch").Range("F6").Value = "" Then
                ThisWorkbook.Sheets("Downpipe Machine Batch").Range("F6:G6") = "0"
                End If
                If ThisWorkbook.Sheets("Downpipe Machine Batch").Range("F7").Value = "" Then
                ThisWorkbook.Sheets("Downpipe Machine Batch").Range("F7:G7") = "0"
                End If
                If ThisWorkbook.Sheets("Downpipe Machine Batch").Range("F8").Value = "" Then
                ThisWorkbook.Sheets("Downpipe Machine Batch").Range("F8:G8") = "0"
                End If
                If ThisWorkbook.Sheets("Downpipe Machine Batch").Range("F9").Value = "" Then
                ThisWorkbook.Sheets("Downpipe Machine Batch").Range("F9:G9") = "0"
                End If
                If ThisWorkbook.Sheets("Downpipe Machine Batch").Range("F10").Value = "" Then
                ThisWorkbook.Sheets("Downpipe Machine Batch").Range("F10:G10") = "0"
                End If
                If ThisWorkbook.Sheets("Downpipe Machine Batch").Range("F11").Value = "" Then
                ThisWorkbook.Sheets("Downpipe Machine Batch").Range("F11:G11") = "0"
                End If
                If ThisWorkbook.Sheets("Downpipe Machine Batch").Range("F12").Value = "" Then
                ThisWorkbook.Sheets("Downpipe Machine Batch").Range("F12:G12") = "0"
                End If
                If ThisWorkbook.Sheets("Downpipe Machine Batch").Range("F13").Value = "" Then
                ThisWorkbook.Sheets("Downpipe Machine Batch").Range("F13:G13") = "0"
                End If
                If ThisWorkbook.Sheets("Downpipe Machine Batch").Range("F14").Value = "" Then
                ThisWorkbook.Sheets("Downpipe Machine Batch").Range("F14:G14") = "0"
                End If
                
                '''Tell the machine the job has been loaded
                ActiveSheet.Range("R3") = "1"
                
                '''AJ3 needs to be 0 awaiting batch complete and opperator load
                
            End If
            End If
            
             '''Grant's magic - NOTHING WORKS IF! Grant's Magic doesn't come on!
                            If ActiveSheet.Range("AK3") = "1" Then
                            ActiveSheet.Range("R3") = "0"
                            ActiveSheet.Range("AJ3") = "0"
                            End If
                '''END the Enforcement Section for Qty/Length
                             
        'IF non of the above criteria is met, call next machine
        Call LoadGutter
            
End Sub


Sub movecompleteddownpipe()


    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
                
                ''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
                
                            Sheets("Downpipe Machine Batch").Select  ''copy data to main menu page
                            ThisWorkbook.Sheets("Downpipe Machine Batch").Range("A3:AN" & i - 1).Select
                            Selection.Copy
                            
                            ''' Open Completed Job Location
                                Workbooks.Open Filename:="C:\Users\Luke.STONEHOMES\Desktop\RecordedDailyJobs.xlsm"
                            '''
                            '''Record the Completed Downpipe Job to DailyRecordedJob Listing in the other workbook
                            Call RecordDownpipe
                                 
End Sub


Sub RecordDownpipe()


Sheets("Downpipe").Select


'Find last row
lastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
        
    Sheets("Downpipe").Activate


        erow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row


ActiveSheet.Cells(erow, 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWorkbook.Close
'Saved & Closed the workbook of record data from downpipe


Call ClearDownpipeBatch


End Sub


Sub ClearDownpipeBatch()


    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
Sheets("Downpipe Machine Batch").Select


            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
                
                            '''Clear the job that was previously manufactured
                            Sheets("Downpipe Machine Batch").Select  ''copy data to main menu page
                            
                            ThisWorkbook.Sheets("Downpipe Machine Batch").Range("A3:CC" & i - 1).Select
                            
                            Selection.ClearContents
                            '''Job has now been cleared successfully
                        
                       '''Unique Value indicating Job is in the ready position for NEW JOB - Waiting for Grant's Magic
                       ActiveSheet.Range("AJ3") = "4"
                                                                                             
                  '' Call next machine ''
                  
            Call LoadDownpipe
          
End Sub

JackDanIce · Sep 14, 2018

Your code alludes to procedure LoadGutter, but you haven't included the code for it.

Below is untested but one way to "tidy" and possibly run faster, comments have been removed so you'll need to add them back in.

General comments:
Declare variables, you're using variables that you haven't declared
Return settings back to their initial value, e.g. Application.Screenupdating = True
You don't need to use .Select just to then read a value from it, it slows code down if nothing else
Your code refers to "1" and other numbers inside speachmarks so code will treat those as strings.
Are you entering into the spreadsheet the number 1 or the character that represents the number 1?
If it's the number 1, then your code needs to change and refer to 1, NOT "1"
You don't need to keep looping the column to find a match, VBA has a FIND function similar to using CTRL+F to find a value on a spreadsheet
What is v in the TimerControl procedure?
What is timer in the TimerControl procedure, you're not using it for anything as far as I can tell

Try:

Rich (BB code):

Sub TimerControl()

   Dim timer   As Variant
    Dim v       As Long
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    timer = Now + TimeValue("00:00:08")
    
    If v = 1 Then Exit Sub
    If v = 0 Then Application.OnTime timer, "LoadDownPipe"
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With

End Sub

Sub LoadDownpipe()

    Dim x   As Long
    Dim t   As Long
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With

    With Sheets("Downpipe Machine Batch")
        Select Case CStr(.Cells(3, 14).Value & .Cells(3, 16).Value & .Cells(3, 36).Value)
            Case Is = "310"
                .Cells(3, 36) = "2"
                .Cells(3, 40).Value = Now
                MoveCompletedDownpipe
            Case Is = "314"
              If .Cells(3, 1) >= 1 Then .Cells(3, 36).Value = "4"
        End Select
        
        If .Cells(6, 2).Value = .Cells(3, 1).Value Then
            x = .Cells(.Rows.Count, 1).End(xlUp).Row
            On Error Resume Next
            t = .Cells(3, 1).Resize(x - 2).Find(what:=.Cells(6, 2).Value, after:=.Cells(1, 3), LookIn:=xlFormulas, lookat:=xlPart, searchorder:=xlByRows).Row
            On Error GoTo 0
                           
            .Cells(3, 1).Resize(t, 26).Value = Sheets("Downpipe Machine Data").Cells(3, 1).Resize(t, 26).Value
            .Cells(3, 39).Value = Now
            x = .Cells(.Columns.Count, 3).End(xlToLeft).Column
            .Cells(1, 3).Resize(t).EntireRow.Delete
            
            .Cells(4, 6).Resize(9).SpecialCells(xlCellTypeBlanks).Resize(, 2).Value = "0"
            .Cells(3, 18).Value = "1"
        End If
            
        If .Cells(3, 37).Value = "1" Then
            .Cells(3, 18).Value = "0"
            .Cells(3, 36).Value = "0"
        End If
    End With
    
    'Code not provided
    'LoadGutter
            
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
         
End Sub

Sub MoveCompletedDownpipe()

    Dim x   As Long
    Dim t   As Long
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
                
    With Sheets("Downpipe Machine Batch")
        x = .Cells(.Rows.Count, 1).End(xlUp).Row
        On Error Resume Next
        t = .Cells(4, 1).Resize(x - 3).Find(what:=.Cells(3, 1).Value, after:=.Cells(3, 1), LookIn:=xlFormulas, lookat:=xlPart, searchorder:=xlByRows).Row
        On Error GoTo 0
        
        If t Then RecordDownpipe Workbooks.Open("C:\Users\Luke.STONEHOMES\Desktop\RecordedDailyJobs.xlsm"), .Cells(3, 1).Resize(t, 40)
    End With
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
                                 
End Sub

Sub RecordDownpipe(ByRef wkb As Workbook, ByRef rng As Range)
    
    With wkb
        .Sheets("Downpipe").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
    End With
    
    wkb.Close savechanges:=True

    ClearDownpipeBatch

End Sub

Sub ClearDownpipeBatch()

    Dim x   As Long
    Dim t   As Long

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    With Sheets("Downpipe Machine Batch")
        x = .Cells(.Rows.Count, 1).End(xlUp).Row
        On Error Resume Next
        t = .Cells(4, 1).Resize(x - 3).Find(what:=.Cells(3, 1).Value, after:=.Cells(3, 1), LookIn:=xlFormulas, lookat:=xlPart, searchorder:=xlByRows).Row
        On Error GoTo 0

        If t > 0 Then
            .Cells(3, 1).Resize(t, 81).ClearContents
            .Cells(3, 36).Value = "4"
        End If
        
        LoadDownpipe
                    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
    
End Sub

Lukums · Sep 14, 2018

JackDanIce said:

Your code alludes to procedure LoadGutter, but you haven't included the code for it.

Below is untested but one way to "tidy" and possibly run faster, comments have been removed so you'll need to add them back in.

General comments:
Declare variables, you're using variables that you haven't declared
Return settings back to their initial value, e.g. Application.Screenupdating = True
You don't need to use .Select just to then read a value from it, it slows code down if nothing else
Your code refers to "1" and other numbers inside speachmarks so code will treat those as strings.
Are you entering into the spreadsheet the number 1 or the character that represents the number 1?
If it's the number 1, then your code needs to change and refer to 1, NOT "1"
You don't need to keep looping the column to find a match, VBA has a FIND function similar to using CTRL+F to find a value on a spreadsheet
What is v in the TimerControl procedure?
What is timer in the TimerControl procedure, you're not using it for anything as far as I can tell

Try:

Rich (BB code):

Sub TimerControl()

   Dim timer   As Variant
    Dim v       As Long
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    timer = Now + TimeValue("00:00:08")
    
    If v = 1 Then Exit Sub
    If v = 0 Then Application.OnTime timer, "LoadDownPipe"
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With

End Sub

Sub LoadDownpipe()

    Dim x   As Long
    Dim t   As Long
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With

    With Sheets("Downpipe Machine Batch")
        Select Case CStr(.Cells(3, 14).Value & .Cells(3, 16).Value & .Cells(3, 36).Value)
            Case Is = "310"
                .Cells(3, 36) = "2"
                .Cells(3, 40).Value = Now
                MoveCompletedDownpipe
            Case Is = "314"
              If .Cells(3, 1) >= 1 Then .Cells(3, 36).Value = "4"
        End Select
        
        If .Cells(6, 2).Value = .Cells(3, 1).Value Then
            x = .Cells(.Rows.Count, 1).End(xlUp).Row
            On Error Resume Next
            t = .Cells(3, 1).Resize(x - 2).Find(what:=.Cells(6, 2).Value, after:=.Cells(1, 3), LookIn:=xlFormulas, lookat:=xlPart, searchorder:=xlByRows).Row
            On Error GoTo 0
                           
            .Cells(3, 1).Resize(t, 26).Value = Sheets("Downpipe Machine Data").Cells(3, 1).Resize(t, 26).Value
            .Cells(3, 39).Value = Now
            x = .Cells(.Columns.Count, 3).End(xlToLeft).Column
            .Cells(1, 3).Resize(t).EntireRow.Delete
            
            .Cells(4, 6).Resize(9).SpecialCells(xlCellTypeBlanks).Resize(, 2).Value = "0"
            .Cells(3, 18).Value = "1"
        End If
            
        If .Cells(3, 37).Value = "1" Then
            .Cells(3, 18).Value = "0"
            .Cells(3, 36).Value = "0"
        End If
    End With
    
    'Code not provided
    'LoadGutter
            
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
         
End Sub

Sub MoveCompletedDownpipe()

    Dim x   As Long
    Dim t   As Long
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
                
    With Sheets("Downpipe Machine Batch")
        x = .Cells(.Rows.Count, 1).End(xlUp).Row
        On Error Resume Next
        t = .Cells(4, 1).Resize(x - 3).Find(what:=.Cells(3, 1).Value, after:=.Cells(3, 1), LookIn:=xlFormulas, lookat:=xlPart, searchorder:=xlByRows).Row
        On Error GoTo 0
        
        If t Then RecordDownpipe Workbooks.Open("C:\Users\Luke.STONEHOMES\Desktop\RecordedDailyJobs.xlsm"), .Cells(3, 1).Resize(t, 40)
    End With
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
                                 
End Sub

Sub RecordDownpipe(ByRef wkb As Workbook, ByRef rng As Range)
    
    With wkb
        .Sheets("Downpipe").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
    End With
    
    wkb.Close savechanges:=True

    ClearDownpipeBatch

End Sub

Sub ClearDownpipeBatch()

    Dim x   As Long
    Dim t   As Long

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    With Sheets("Downpipe Machine Batch")
        x = .Cells(.Rows.Count, 1).End(xlUp).Row
        On Error Resume Next
        t = .Cells(4, 1).Resize(x - 3).Find(what:=.Cells(3, 1).Value, after:=.Cells(3, 1), LookIn:=xlFormulas, lookat:=xlPart, searchorder:=xlByRows).Row
        On Error GoTo 0

        If t > 0 Then
            .Cells(3, 1).Resize(t, 81).ClearContents
            .Cells(3, 36).Value = "4"
        End If
        
        LoadDownpipe
                    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
    
End Sub

Hello Jack,

You clearly put a lot of work into this, I wanted to say a big thank you - I have yet to test it and can't test it not properly until Monday with our factory.

That said I wanted to branch on a few things -

General comments:
Declare variables, you're using variables that you haven't declared

1. Understood this is a very bad habit when I was "learning and still am" I'll be sure to start breaking this down and declare what I use.

Return settings back to their initial value, e.g. Application.Screenupdating = True

2. This was done last night when I noticed I never set back to True, understood.

You don't need to use .Select just to then read a value from it, it slows code down if nothing else

3. .Select is my kryptonite it's a bad habit, I have to learn how to do what you did in detail and will need to teach myself.

Your code refers to "1" and other numbers inside speachmarks so code will treat those as strings.

4. Is this generally an issue? I would assume so. Hence you mentioned it.

Are you entering into the spreadsheet the number 1 or the character that represents the number 1?

5. Technically the machines in the trigger the 1 on the spreadsheet. It physically enters the number 1.

If it's the number 1, then your code needs to change and refer to 1, NOT "1"

6. If I change it to 1, can you just breifly explain the benefit? You've taken the time to re-write this I want to understand so I can perhaps help someone down the line like you've helped me.

You don't need to keep looping the column to find a match, VBA has a FIND function similar to using CTRL+F to find a value on a spreadsheet

7. This one completely has blown my mind - You don't need to loop constantly like what I'm doing every 8 seconds? VBA can find/trigger these automatically????!?

What is v in the TimerControl procedure?

8. This was re-written last night it wasn't doing what it was supposed to be doing or what it was intended for - v = 0 (run automation sub routines) - if v = 1 (which is a button, save workbook and exit sub) this is resolved. Sorry about that.

What is timer in the TimerControl procedure, you're not using it for anything as far as I can tell

9. TimerControl - it is used once the last machine runs it loops back to timercontrol pauses for 8 seconds and then calls the down pipe sub routine which is what we are working on.
I'm having to PAUSE my loop for 8 seconds to give a chance for the other machines to move/shift data around when those 1 / 3 values are found declaring that the job is in fact "completed"

Again, an absolute massive thank you for your time investment so far - it is truly appreciated.

Luke Christie

JackDanIce · Sep 15, 2018

Hi Luke,

To expand, to the PC, "1" is same as "one" it's not a numerical data type so it will try to guess if that's what you meant. You're better of using 1 as that is the number and value of the cell.

Inside the cell if the value is NOT "1" (with the speachmarks) then your code shouldn't have them either.

Anyway, test it first, likely to error as wasn't able to test

Nasty, Ugly Code - Requires a Trim

Lukums

Board Regular

Excel Facts

JackDanIce

Well-known Member

Lukums

Board Regular

JackDanIce

Well-known Member

Similar threads

Forum statistics

Share this page

Nasty, Ugly Code - Requires a Trim

Lukums

Board Regular

Excel Facts

JackDanIce

Well-known Member

Lukums

Board Regular

JackDanIce

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock