How to stop code from proceeding if cancel is pressed in Sheet Selector code?

[CC268]

I have the following code that is called out and used to select a sheet before proceeding on. The problem is the code continues on after

Call Sheet_Selector

even if I press cancel and don't select a sheet. Is there something I can place after the

Call Sheet_Selector

to prevent the code from moving on even if I cancel?

Option Explicit

Sub Format_AsBuilt()


Dim CopyFromWbk, CopyToWbk, wb As Workbook
Dim ShToCopy As Worksheet
Dim FileName, currentlevel, currentpart, currentserial, currentrev As Variant
Dim inrow, inlevel As Long


Call OptimizeCode_Begin


Set CopyFromWbk = FileDialog_Open()
If CopyFromWbk Is Nothing Then Exit Sub


[COLOR=#ff0000][B]Call Sheet_Selector[/B][/COLOR]


Set ShToCopy = CopyFromWbk.ActiveSheet
Set CopyToWbk = ThisWorkbook
ShToCopy.Copy After:=CopyToWbk.Sheets(CopyToWbk.Sheets.Count)
ActiveSheet.Name = "Sheet1"
CopyFromWbk.Close savechanges:=False


Rows("1:9").Delete
Columns("B:D").Insert
Cells(1, 2) = "NHA Part Number"
Cells(1, 3) = "NHA Serial Number"
Cells(1, 4) = "NHA Rev"
Columns("L:R").EntireColumn.Delete
Columns.AutoFit
ActiveSheet.Cells.UnMerge
Columns("G:G").Select
Selection.Copy
Columns("F:F").Select
Selection.Insert Shift:=xlToRight
Columns("H:H").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("I:I").Select
Selection.Copy
Columns("G:G").Select
Selection.Insert Shift:=xlToRight
Columns("J:J").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft


Dim partno(6) As Variant 'defining our variables - variant is a data type that can hold any type of value you want
Dim serialno(6) As Variant 'same as above
Dim revno(6) As Variant 'same as above
inrow = 2 'defining the variable "inrow" to equal 2
inlevel = 0 'defining the variable "inlevel" to equal 0


Range("b2:d5000").ClearContents 'this is simply taking the range of b2:d5000 and clearing the contents of the cells


While Cells(inrow, 1) <> "" 'while cell in row 2, column 1...
currentlevel = Cells(inrow, 1) 'the variable currentlevel is equal to the value of the cell in row 2, column 1
currentpart = Cells(inrow, 5) 'the variable currentpart is equal to the value of the cell in row 2, column 5
currentserial = Cells(inrow, 6) 'the variable currentserial is equal to the value of the cell in row 2, column 6
currentrev = Cells(inrow, 7) ' the variable currentrev is equal to the value of the cell in row 2, column 7
partno(currentlevel) = currentpart 'the variable partno in the currentlevel is equal to the variable currentpart (whatever value is in row 2, column 5)
serialno(currentlevel) = currentserial 'the variable serialno in the currentlevel is equal to the variable currentserial (whatever value is in row 2, column 6)
revno(currentlevel) = currentrev 'the variable revno in the currentlevel is equal to the variable currentrev (whatever value is in row 2, column 7)
    
If currentlevel > 1 Then 'if the value in row 2, column 1 is greater than 1 then proceed to the following...
Cells(inrow, 2) = partno(currentlevel - 1) 'the value in row 2, column 2 = value of partno in the current level - 1
Cells(inrow, 3) = serialno(currentlevel - 1) 'the value in row 2, column 3 = value of partno in the current level - 1
Cells(inrow, 4) = revno(currentlevel - 1) 'the value in row 2, column 4 = value of partno in the current level - 1
End If 'end if statement
        
inrow = inrow + 1 'move onto the next row (row 3)
Wend 'end while loop


Columns("A").EntireColumn.Delete


Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove


Dim Lst As Long
Lst = Range("B" & Rows.Count).End(xlUp).Row


With Range("A1")
    .Value = "1"
    .AutoFill Destination:=Range("A1").Resize(Lst), Type:=xlFillSeries
End With


'Cells.Select
    ' With Selection
       ' .WrapText = False
     'End With
     
'Columns.HorizontalAlignment = xlCenter
'Columns.VerticalAlignment = xlCenter
'Columns.AutoFit
'Rows.AutoFit


'Cells.Select
    'With Selection.Interior
        '.Pattern = xlNone
        '.TintAndShade = 0
        '.PatternTintAndShade = 0
    'End With
    
'Cells.Select
   ' With Selection.Borders
   ' .LineStyle = xlNone
   ' End With


'Range("A1").Select
'ActiveSheet.UsedRange.SpecialCells (xlCellTypeLastCell) 'matches vertical scrollbar length to number of rows
'Sheets("MACROS").Select
    
Call OptimizeCode_End
    
End Sub

Sub Sheet_Selector()Const ColItems  As Long = 20
Const LetterWidth As Long = 20
Const HeightRowz As Long = 18
Const SheetID As String = "__SheetSelection"
 
Dim i%, TopPos%, iSet%, optCols%, intLetters%, optMaxChars%, optLeft%
Dim wsDlg As DialogSheet, objOpt As OptionButton, optCaption$, objSheet As Object
optCaption = "": i = 0
 
Application.ScreenUpdating = False
 
On Error Resume Next
Application.DisplayAlerts = False
ActiveWorkbook.DialogSheets(SheetID).Delete
Application.DisplayAlerts = True
Err.Clear
 
Set wsDlg = ActiveWorkbook.DialogSheets.Add
With wsDlg
.Name = SheetID
.Visible = xlSheetHidden
iSet = 0: optCols = 0: optMaxChars = 0: optLeft = 78: TopPos = 40
 
For Each objSheet In ActiveWorkbook.Sheets
If objSheet.Visible = xlSheetVisible Then
i = i + 1
 
If i Mod ColItems = 1 Then
optCols = optCols + 1
TopPos = 40
optLeft = optLeft + (optMaxChars * LetterWidth)
optMaxChars = 0
End If
 
intLetters = Len(objSheet.Name)
If intLetters > optMaxChars Then optMaxChars = intLetters
iSet = iSet + 1
.OptionButtons.Add optLeft, TopPos, intLetters * LetterWidth, 16.5
.OptionButtons(iSet).Text = objSheet.Name
TopPos = TopPos + 13
 
End If
Next objSheet
 
If i > 0 Then
 
.Buttons.Left = optLeft + (optMaxChars * LetterWidth) + 24
 
With .DialogFrame
.Height = Application.Max(68, WorksheetFunction.Min(iSet, ColItems) * HeightRowz + 10)
.Width = optLeft + (optMaxChars * LetterWidth) + 24
.Caption = "Select sheet to go to"
End With
 
.Buttons("Button 2").BringToFront
.Buttons("Button 3").BringToFront
Application.ScreenUpdating = True
 
If .Show = True Then
For Each objOpt In wsDlg.OptionButtons
If objOpt.Value = xlOn Then
optCaption = objOpt.Caption
Exit For
End If
Next objOpt
End If
 
If optCaption = "" Then
MsgBox "You did not select a worksheet.", 48, "Cannot continue"
Exit Sub
Else
 
'MsgBox "You selected the sheet named ''" & optCaption & "''." & vbCrLf & "Click OK to go there.", 64, "FYI:"
Sheets(optCaption).Activate
 
End If
 
End If
 
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
 
End With
End Sub

 

[portews]

I think the trouble is when you don't select a workbook, you are exiting the sub, which continues on where it was called from. I believe you want to stop all code, rather than just exit from the sub. (not tested)

Near the bottom of Sub Sheet_Selector(), change the "Exit Sub" to "End"

If optCaption = "" Then
MsgBox "You did not select a worksheet.", 48, "Cannot continue"
[COLOR=#00ff00]'Exit Sub[/COLOR]
[COLOR=#ff0000]End[/COLOR]
Else
 
'MsgBox "You selected the sheet named ''" & optCaption & "''." & vbCrLf & "Click OK to go there.", 64, "FYI:"
Sheets(optCaption).Activate
 
End If

 

[dmt32]

Hi,
try update to your function:

Function FileDialog_Open() As Workbook
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = False
        If .Show Then
            Set FileDialog_Open = Workbooks.Open(.SelectedItems(1))
        Else
            Set FileDialog_Open = Nothing
        End If
    End With
End Function

Sub Format_AsBuilt()




Dim CopyFromWbk, CopyToWbk, wb As Workbook
Dim ShToCopy As Worksheet
Dim FileName, currentlevel, currentpart, currentserial, currentrev As Variant
Dim inrow, inlevel As Long




Call OptimizeCode_Begin




Set CopyFromWbk = FileDialog_Open()
If CopyFromWbk Is Nothing Then Exit Sub




Call Sheet_Selector




'rest of code


End Sub

line shown in RED should now execute correctly if Cancel Button Pressed

I also note from your post that you have not heeded advice about how variables are declared - The workbook object variables only the last one in your list is correctly declared as a Workbook - same with inlevel declared as long. You must explicitly declare required data type after each variable.

Dave

 

[CC268]

Thanks a lot for the replies guys I'm gonna give this a shot when I get back in office Monday

 

[CC268]

I think the trouble is when you don't select a workbook, you are exiting the sub, which continues on where it was called from. I believe you want to stop all code, rather than just exit from the sub. (not tested)

Near the bottom of Sub Sheet_Selector(), change the "Exit Sub" to "End"

If optCaption = "" Then
MsgBox "You did not select a worksheet.", 48, "Cannot continue"
[COLOR=#00ff00]'Exit Sub[/COLOR]
[COLOR=#ff0000]End[/COLOR]
Else
 
'MsgBox "You selected the sheet named ''" & optCaption & "''." & vbCrLf & "Click OK to go there.", 64, "FYI:"
Sheets(optCaption).Activate
 
End If

This worked! What a simple fix...

 

[CC268]

Hi,
try update to your function:

line shown in RED should now execute correctly if Cancel Button Pressed

I also note from your post that you have not heeded advice about how variables are declared - The workbook object variables only the last one in your list is correctly declared as a Workbook - same with inlevel declared as long. You must explicitly declare required data type after each variable.

Dave

Dave I had just been busy and hadn't declared all the variables in the list as you had told me to. I have since done that.