thomas.szwed
12-10-2007, 06:40 AM
Hello all,
I have a Sub below which when run....
- gives a warning message before continuing to user....
- an input box appears allowing the user to name a new workbook full of data which it copies from the current sheet "for archive"
- then clears the cells of the "for archive" sheet
except its not doing anything at the moment! I suspect this may be because there is something making it exit the sub.......can anyone analyse and identify where ive gone wrong?
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. 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 NewName = 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
Many Thanks!
I have a Sub below which when run....
- gives a warning message before continuing to user....
- an input box appears allowing the user to name a new workbook full of data which it copies from the current sheet "for archive"
- then clears the cells of the "for archive" sheet
except its not doing anything at the moment! I suspect this may be because there is something making it exit the sub.......can anyone analyse and identify where ive gone wrong?
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. 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 NewName = 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
Many Thanks!