thomas.szwed
12-11-2007, 03:32 AM
Hello,
Having a small problem with my cancel button in the following code....When i press cancel it still performs the vbOK action for some reason when it should be exiting the Sub....can anyone see where im going wrong??
Thanks a lot
Sub CreateArchive()
Sheets("For Archive").Activate
Dim msgResponse As String 'confirm delete
Application.ScreenUpdating = False
'get user confirmation
msgResponse = MsgBox("This will archive records from the 'For Archive' Sheet. This action is irreversible. Continue?", _
vbCritical + vbYesNo, "Archive Records")
Select Case msgResponse 'action dependent on response
Case vbYes
'Input box to name new file
NewName = InputBox("Enter Month for filename", "Archiving Records", vbOKCancel)
If vbOK Then
'Save it with the NewName and in the same directory as original
Worksheets("For Archive").Copy
ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".xls"
ActiveWorkbook.Close SaveChanges:=False
Worksheets("For Archive").Range("A2:AC65000").ClearContents
Else
Exit Sub
End If
Case vbNo
Exit Sub
End Select
End Sub
Having a small problem with my cancel button in the following code....When i press cancel it still performs the vbOK action for some reason when it should be exiting the Sub....can anyone see where im going wrong??
Thanks a lot
Sub CreateArchive()
Sheets("For Archive").Activate
Dim msgResponse As String 'confirm delete
Application.ScreenUpdating = False
'get user confirmation
msgResponse = MsgBox("This will archive records from the 'For Archive' Sheet. This action is irreversible. Continue?", _
vbCritical + vbYesNo, "Archive Records")
Select Case msgResponse 'action dependent on response
Case vbYes
'Input box to name new file
NewName = InputBox("Enter Month for filename", "Archiving Records", vbOKCancel)
If vbOK Then
'Save it with the NewName and in the same directory as original
Worksheets("For Archive").Copy
ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "\" & NewName & ".xls"
ActiveWorkbook.Close SaveChanges:=False
Worksheets("For Archive").Range("A2:AC65000").ClearContents
Else
Exit Sub
End If
Case vbNo
Exit Sub
End Select
End Sub