Exit sub problem.

[gjsala]

I wrote some code in VBA for excel 2K and while watching the program run, I noticed the program will jump from the bottom of the code , line 100, to the middle, line 25, and rerun some code that was already executed. Why won't the program end at the last "End Sub" when no other subs are called?

Thanks for any input.

 

[xlbo]

Dunno - if you post your code it might help......

Some suggestions are a goto line, an if statement or a loop may be causing the problem

Rgds, Geoff
Si hoc legere scis, nimis eruditionis habes
Want the best answers to your questions ? - then read me baby one more time - faq222-2244

 

[gjsala]

Sub ProjectSchedule()
'version 2.1
Dim Message As String, Title As String, Default As String
Dim myRange As range, rngTotal As range, c As range
Const strFind As String = "Samp-Mark"
Dim MyNewWbk As Workbook, inpWB As String, inpWS As String
Dim tempWB As Workbook
Dim fouNd As Boolean
Dim r As Long, z As Long, a As Long, b As Long
Dim numRows As Integer
Dim ans As Integer
Dim p As range
Application.DisplayAlerts = False
'Workbooks.Open Filename:="c:\book4.xls"
inpWB = ActiveWorkbook.Name
Worksheets("Schedule 2003&quot.Activate
'Worksheets("Sheet1&quot.Activate
Message = "Please select your date." ' Set prompt.
Title = "InputBox Demo" ' Set title.
Default = "User input here" ' Set default.
On Error Resume Next
Set myRange = Application.InputBox(Message, Title, Default, , , , , 8)
On Error GoTo 0
If myRange Is Nothing Then
MsgBox "No date was entered, program will end!"
Exit Sub
End If
Application.ScreenUpdating = False
With Worksheets("Schedule 2003&quot.range("A1:T1200&quot
'With Worksheets("Sheet1&quot.range("A1:T1200&quot
'amend range to suit
Set c = .Find(What:=strFind, after:=range(myRange.Address), _
LookIn:=xlValues, SearchOrder:=xlByColumns) ', LookAt:=xlWhole
If Not c Is Nothing Then
'found it
Set rngTotal = .range(myRange, c.Offset(0, 3)) 'changed from (0,2)
rngTotal.Copy
End If
End With
Set MyNewWbk = Workbooks.Add
Sheets("Sheet1&quot.Select
Sheets("Sheet1&quot.Name = "WEEK"
MyNewWbk.Worksheets("WEEK&quot.range("A1&quot.PasteSpecial Paste:=xlValues
range("A1&quot.Select
Selection.NumberFormat = "d-mmm"
'add a new workbook and copy the data to it
Application.CutCopyMode = False
Cells.Select
Cells.EntireColumn.AutoFit
range("A1&quot.Select
Workbooks(inpWB).Close False

'Round to nearest number
Columns("D&quot.Select
Selection.NumberFormat = "0"

'Deletes empty rows
LastRow = ActiveSheet.UsedRange.Row - 1 + _
ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
For r = LastRow To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r
'takes out empty rows if no projects is inserted
Set myRange = ActiveSheet.range("A1:A6500&quot
numRows = Application.CountA(myRange)
For z = 1 To numRows
If Cells(z, 1) = "" Then
Rows(z).Delete
End If
Next z
Call Markers
End Sub
Sub endsub()
Exit Sub
End Sub

Sub Markers()
Dim p As range, rng As range, lLastRow As Long, ans As Variant
'Asking the right number of markers?
Application.ScreenUpdating = True
lLastRow = Cells(Cells.Rows.Count, "C&quot.End(xlUp).Row
Set rng = range(Cells(1, "C&quot, Cells(lLastRow, "D&quot)
repl = MsgBox("Are the # of markers correct?", vbYesNo, "Project Status&quot
If repl = vbYes Then
Call Calculate
End If
If repl = vbNo Then
Call inputA
End If
End Sub
Sub inputA()
'Selecting the cell to change.
ans = Application.InputBox("Type the cell you wish to change. For example: C23.", Cell)
If ans = False Then
MsgBox ("Please type in a cell to change!&quot, vbCritical, Warning
Call inputA
End If
If ans = "" Then
MsgBox ("Please type in a cell to change!&quot, vbCritical, Warning
Call inputA
End If
inp = InputBox("Type in the new number.", Cell)
If inp = "" Then
MsgBox ("Please type in a number!&quot, vbCritical, Warning
Call inputA
End If
range(ans).Value = inp

'Asking to change more cells.
quest = MsgBox("Do you have more markers to change?", vbYesNo, "Next step&quot
If quest = vbYes Then
Call inputA
End If
If quest = vbNo Then
Call Calculate
End If

End Sub

Sub Calculate()
'Continue with program
Const strFind As String = "Samp-Mark"
Application.ScreenUpdating = False
'Copy to temp workbook
Cells.Select
Selection.Copy
'Set tempWB = Workbooks.Add
Sheets("Sheet2&quot.Select
Sheets("Sheet2&quot.Name = "PLATES"
range("A1&quot.Select
ActiveSheet.Paste


'Calculate the number of plates that are less then 384
Set myRange = ActiveSheet.range("A1:A6500&quot
numRows = Application.CountA(myRange)
For r = 3 To numRows
If Cells(r, 1) = strFind Then
Call Greaterthan384
End If
If Cells(r, 3) < 384 Then
If (Cells(r, 3)) <= 32 Then
Cells(r, 3) = 12
Cells(r, 5).Select
ActiveCell.FormulaR1C1 = &quot;=RC[-1]/RC[-2]&quot;
a = Cells(r, 5)

'b = Cells(r, 7)
Cells(r, 7).Select
ActiveCell.FormulaR1C1 = &quot;=(RC[-2]/3)&quot;
b = Cells(r, 7)
Selection.NumberFormat = &quot;[hh]:mm&quot;
ActiveCell = b / 24
End If
If (Cells(r, 3)) > 33 Then
If Cells(r, 1) = strFind Then
Call Greaterthan384
End If
If (Cells(r, 3)) <= 48 Then
Cells(r, 3) = 8
Cells(r, 5).Select
ActiveCell.FormulaR1C1 = &quot;=RC[-1]/RC[-2]&quot;
a = Cells(r, 5)

Cells(r, 7).Select
ActiveCell = a / 6
b = Cells(r, 7)
Selection.NumberFormat = &quot;[hh]:mm&quot;
ActiveCell = b / 24
'ActiveCell.FormulaR1C1 = &quot;=RC[-2]/6&quot;
End If
End If
If (Cells(r, 3)) > 49 Then
If Cells(r, 1) = strFind Then
Call Greaterthan384
End If
If (Cells(r, 3)) <= 96 Then
Cells(r, 3) = 4
Cells(r, 5).Select
ActiveCell.FormulaR1C1 = &quot;=RC[-1]/RC[-2]&quot;


Cells(r, 7).Select
ActiveCell.FormulaR1C1 = &quot;=(RC[-2]/8)&quot;
b = Cells(r, 7)
Selection.NumberFormat = &quot;[hh]:mm&quot;
ActiveCell = b / 24
End If
End If
'If (Cells(r, 3)) > 97 Then
' If (Cells(r, 3)) < 143 Then
' Cells(r, 3) = 3
' Cells(r, 5).Select
' ActiveCell.FormulaR1C1 = &quot;=RC[-1]/RC[-2]&quot;


' Cells(r, 7).Select
' ActiveCell.FormulaR1C1 = &quot;=(RC[-2]/10)&quot;
' End If
'End If
If (Cells(r, 3)) > 97 Then
If Cells(r, 1) = strFind Then
Call Greaterthan384
End If
If (Cells(r, 3)) <= 192 Then
Cells(r, 3) = 2
Cells(r, 5).Select
ActiveCell.FormulaR1C1 = &quot;=RC[-1]/RC[-2]&quot;


Cells(r, 7).Select
ActiveCell.FormulaR1C1 = &quot;=(RC[-2]/10)&quot;
b = Cells(r, 7)
Selection.NumberFormat = &quot;[hh]:mm&quot;
ActiveCell = b / 24
End If
End If
If (Cells(r, 3)) > 193 Then
If Cells(r, 1) = strFind Then
Call Greaterthan384
End If
If (Cells(r, 3)) < 384 Then
Cells(r, 3) = 1
Cells(r, 5).Select
ActiveCell.FormulaR1C1 = &quot;=RC[-1]/RC[-2]&quot;


Cells(r, 7).Select
ActiveCell.FormulaR1C1 = &quot;=(RC[-2]/4)&quot;
b = Cells(r, 7)
Selection.NumberFormat = &quot;[hh]:mm&quot;
ActiveCell = b / 24
End If
End If
End If
Next r
End Sub
Sub Greaterthan384()
Const strFind As String = &quot;Samp-Mark&quot;
Set myRange = ActiveSheet.range(&quot;A1:A6500&quot
numRows = Application.CountA(myRange)

For r = 3 To numRows
If Cells(r, 1) = strFind Then
Call FormateCells
End If
If (Cells(r, 3)) > 384 Then
ans = (Cells(r, 3)) / 384
Cells(r, 3) = ans
Cells(r, 5).Select
ActiveCell.FormulaR1C1 = &quot;=RC[-2]*RC[-1]&quot;
Cells(r, 7).Select
ActiveCell.FormulaR1C1 = &quot;=(RC[-2]/5)&quot;
b = Cells(r, 7)
Selection.NumberFormat = &quot;[hh]:mm&quot;
ActiveCell = b / 24
End If
Next r
End Sub
Sub FormateCells()
Const strFind As String = &quot;Samp-Mark&quot;


'range(&quot;G3:G69&quot.Select
'Columns(&quot;G:G&quot.Select
'Application.CutCopyMode = False
'Selection.Copy
'range(&quot;H1&quot.Select
'Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
' False, Transpose:=False
'Columns(&quot;G:G&quot.Select
'Application.CutCopyMode = False
'Selection.Delete Shift:=xlToLeft


range(&quot;E3:E69&quot.Select
Columns(&quot;E:E&quot.Select
Application.CutCopyMode = False
Selection.Copy
range(&quot;F1&quot.Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Columns(&quot;E:E&quot.Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns(&quot;F:F&quot.Select
Selection.Insert Shift:=xlToRight

'Round up formula for pcr plates
Set myRange = ActiveSheet.range(&quot;A1:A6500&quot
numRows = Application.CountA(myRange)
For r = 3 To numRows
If Cells(r, 5) > 0.01 Then
Cells(r, 6).Select
ActiveCell.FormulaR1C1 = &quot;=ROUNDUP(RC[-1],0.1)&quot;
End If
Next r

'Clean up the round up numbers
Columns(&quot;G:G&quot.Select
Selection.Insert Shift:=xlToRight
Columns(&quot;F:F&quot.Select
Selection.Copy
range(&quot;G1&quot.Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Columns(&quot;E:F&quot.Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft


For r = 3 To numRows
If (Cells(r, 5)) < 1 Then
Cells(r, 5) = 1
End If
If Cells(r, 1) = strFind Then
Call Finish
End If
Next r
End Sub
Sub Finish()
Const strFind As String = &quot;Samp-Mark&quot;
range(&quot;a1&quot.Select

Set myRange = ActiveSheet.range(&quot;A1:A650&quot
numRows = Application.CountA(myRange)
For r = 1 To numRows
fouNd = False
If Cells(r, 1) = strFind Then
fouNd = True
Cells(r, 5) = 0
Cells(r, 3) = 0
Cells(r, 6) = 0
'Cells(r, 6) = Selection.NumberFormat = &quot;0.0&quot;
'Cells(r, 6) = Selection.ClearContents
End If
Next r

range(&quot;I1&quot.Select
ActiveCell.FormulaR1C1 = &quot;=SUM(R[2]C[-3]:R[68]C[-3])&quot;


range(&quot;F1&quot.Select
ActiveCell.FormulaR1C1 = &quot;=SUM(R[2]C[-1]:R[40]C[-1])&quot;


range(&quot;E1&quot.Select
ActiveCell.FormulaR1C1 = &quot;1&quot;

range(&quot;F1&quot.Select
Application.CutCopyMode = False
Selection.Copy
range(&quot;F2&quot.Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Selection.NumberFormat = &quot;0&quot;


range(&quot;I1&quot.Select
Application.CutCopyMode = False
Selection.Copy
range(&quot;I2&quot.Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Selection.NumberFormat = &quot;[hh]:mm&quot;

For r = 1 To numRows
fouNd = False
If Cells(r, 1) = strFind Then
fouNd = True
Cells(r, 5) = Cells(2, 6)
Cells(r, 6) = Cells(2, 9)
Cells(r, 6).Select
Selection.NumberFormat = &quot;[hh]:mm&quot;
Cells(r, 5).Select
Selection.NumberFormat = &quot;0.0&quot;
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With

Cells(r, 6).Select
'Selection.NumberFormat = &quot;0.0&quot;
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Cells(2, 9).Select
'Selection.NumberFormat = &quot;0.0&quot;
Cells(2, 5) = Cells(r, 6)
Cells(2, 5).Select
Selection.NumberFormat = &quot;[hh]:mm&quot;
'Selection.NumberFormat = &quot;0.0&quot;
End If
Next r
range(&quot;I1:I2:F1:F2&quot.Select
Selection.Delete Shift:=xlToLeft


range(&quot;E1:E200&quot.Select
Application.CutCopyMode = False
Selection.Copy
range(&quot;A1&quot.Select
Worksheets(&quot;WEEK&quot.Activate
range(&quot;E1&quot.Select
ActiveSheet.Paste
'Worksheets(&quot;Sheet2&quot.Activate
'Columns(&quot;A:J&quot.Select
'Selection.Delete Shift:=xlToLeft
range(&quot;A1&quot.Select
Worksheets(&quot;WEEK&quot.Activate

Columns(&quot;D:E&quot.Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With

'Highlighting the number of pcr plates
For r = 1 To numRows
If Cells(r, 1) = strFind Then
Cells(r, 5).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End If
Next r

'Format the time.
range(&quot;G2&quot.Select
range(&quot;H2&quot.Select
'ActiveCell.FormulaR1C1 = _
' &quot;=INT(RC[-3])& &quot;&quot; hrs &quot;&quot;& ROUND((RC[-3]-INT(RC[-3]))*60,0)& &quot;&quot; min&quot;&quot;&quot;
'range(&quot;H2&quot.Select
'Selection.Copy
'range(&quot;H3&quot.Select
'Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
' False, Transpose:=False
'Application.CutCopyMode = False
'Selection.Copy
'range(&quot;E2&quot.Select
'ActiveSheet.Paste
'Columns(&quot;G:H&quot.Select
'Selection.ClearContents
'Selection.Interior.ColorIndex = xlNone
'Columns(&quot;E:E&quot.Select
'Columns(&quot;E:E&quot.EntireColumn.AutoFit


range(&quot;E2&quot.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
range(&quot;A1&quot.Select
Worksheets(&quot;PLATES&quot.Activate
range(&quot;E2&quot.Select
Selection.Delete Shift:=xlToLeft
Worksheets(&quot;WEEK&quot.Activate

'copy information from sheet 1 to sheet 2
Sheets(&quot;WEEK&quot.Select
Columns(&quot;A&quot.Select
Application.CutCopyMode = False
Selection.Copy
Sheets(&quot;PLATES&quot.Select
Columns(&quot;A&quot.Select
ActiveSheet.Paste
'centering column f
Columns(&quot;E:F&quot.Select
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
range(&quot;A1&quot.Select
Worksheets(&quot;WEEK&quot.Activate
range(&quot;A1&quot.Select
ActiveWindow.SelectedSheets.PrintPreview
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Exit Sub

End Sub

 

[JohnCHolmes]

You know, when testing these things and you have problems like this you should not suppress DisplayAlerts. Perhaps you're already beyond that point but it's generally good advice.

Another useful practice is using Option Explicit, if you're not already. (It would appear not)

There are several potential reasons for your malady. Since you posted the code it looks like error handling resumption might be ruled out.

At any rate to get good help, instead of referring to &quot;line 100&quot; like a mainframer (LOL!) how about inserting prominent comments like this in your code so we can help:

'
' NEXT LINE IS THE FIRST EXECUTED AFTER THE JUMP
'
Application.ScreenUpdating = False

... ... ...

'
' NEXT LINE IS THE LAST EXECUTED BEFORE THE JUMP
'
Exit Sub

Then perhaps an easy answer will come to you

 

[xlbo]

I agree with John - take out the error handling and run it - should give you the answer

Rgds, Geoff
It's Super Happy Campo Funtime!
Want the best answers to your questions ? - then read me baby one more time - faq222-2244

 

[gjsala]

JohnCHolmes,
Thanks for your insight on my code. Sometimes it takes an outsider to point out the small stuff that effects the whole picture. Everything works.