Call Sub for sheet selection - continues onto next lines of code even if you cancel

**CC268** · 02-03-2017, 05:20 PM

I am hoping someone can help me here. I have the following code below I took from a fellow on MrExcel. I call this out to allow the user to select what sheet they would like to use the code on. However, I noticed if I press "Cancel" it continues to run the rest of the code that it is is called out in (highlighted in orange). Is there something I can do so that if "Cancel" is pressed it will actually exit the Sub and stop?

Select Sheet code:

Sub Sheet_Selector()

'Call OptimizeCode_Begin

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

'Call OptimizeCode_End

End Sub

Code that calls out the Select Sheet code:

Option Explicit

Sub Format_AsBuilt()

'Call OptimizeCode_Begin

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

MsgBox "OPEN CM AS BUILT!"
Set CopyFromWbk = FileDialog_Open()
Application.FileDialog(msoFileDialogOpen).Title = "***OPEN CM AS BUILT***"
If CopyFromWbk Is Nothing Then Exit Sub

Call Sheet_Selector

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