Worksheet automatically saves itself after data is inputted in cel

[Bob]

I have created a questionnaire. Midway through it, I ask the user for their
student ID (located in cell B12). After the user has inputted their ID and
pressed either the Enter key or an arrow key, I would like the worksheet to
automatically Save itself to the user's Desktop with the filename: "Student
Questionnaire xxxxx.xls" where "xxxxx" is the user's student ID.

Please note that some students use Excel 2003 while others use Excel 2007.
However, I need to have the worsheet saved in the Excel 2003 file format.

Being relatively new to VBA, I have no idea how to program this. Can anyone
help me?

Thanks,
Bob

 

[Jacob Skaria]

Right click the sheet tab>View code and paste the below worksheet event...Try
and feedback

Private Sub Worksheet_Change(ByVal Target As Range)
Dim strFile As String
Dim objWShell As Object, strFolder As String
Application.EnableEvents = False
If Not Application.Intersect(Target, Range("B12")) Is Nothing And _
Trim(Range("B12")) <> "" Then
strFile = "Student Questionnaire " & Range("B12") & ".xls"
If Val(Application.Version) < 12 Then
FileExtStr = ".xls": FileFormatNum = -4143
Else
FileExtStr = ".xls": FileFormatNum = 56
End If
Set objWShell = CreateObject("WScript.Shell")
strFolder = objWShell.SpecialFolders("Desktop")
ActiveWorkbook.SaveAs strFolder & "\" & strFile, FileFormat:=FileFormatNum
Set objWShell = Nothing
End If
Application.EnableEvents = True
End Sub


If this post helps click Yes

 

[Per Jessen]

Hi Bob

This should do it. Please notice the this is event code, so it has to be
pasted into the codesheet for the desired sheet:

Private Function GetDesktopPath() As String
Dim objShell As Object
Dim objFolderDsk As Object
Dim strDsk As String
Set objShell = CreateObject("Shell.Application")
Set objFolderDsk = objShell.Namespace(&H10&)
strDsk = objFolderDsk.Self.Path
GetDesktopPath = strDsk
Set objShell = Nothing
End Function

Private Sub Worksheet_Change(ByVal Target As Range)
Dim StudID As String
Dim DestPath As String
Dim SaveAsFileName As String
Set isect = Intersect(Target, Range("B12"))
If Not isect Is Nothing Then
DestPath = GetDesktopPath()
StudID = Range("B12").Value
SaveAsFileName = "\Student Questionnaire " & StudID & ".xls"
If Application.Version = 12# Then
ThisWorkbook.SaveAs Filename:=DestPath & SaveAsFileName,
FileFormat:=xlExcel8
Else
ThisWorkbook.SaveAs Filename:=DestPath & SaveAsFileName
End If
End If
End Sub

Regards,
Per

 

[Bob]

Jacob,

Your code worked perfectly! Thanks a million!

If I may impose on you one final time, instead of automatically saving the
worksheet after a user has inputted their ID in cell B12, how would I modify
your code so that the user is prompted to input their ID in a pop-up dialog
box right after the worksheet has been opened? Please note that the inputted
ID must be an integer between 10000 and 99999. Once the user inputted a
valid ID, the worksheet would then automatically save itself.

Thanks again,
Bob

 

[Bob]

Per,

Thanks for your help!

Although Jacob and you came up with slightly different methodologies, it was
very helpful to see how two programmers approach and solve the same problem.
Being relatively new to VBA, studying Jacob's and your code was a good
learning experience for me.

Thanks again for taking the time to help me out.

Bob

 

[Per Jessen]

Bob,

Thanks for your reply. I am glad to help.

This is workbook eventcode, so it has to be pasted into the code sheet
for ThisWorkbook.

Private Sub Workbook_Open()
Dim strFile As String
Dim objWShell As Object, strFolder As String
Dim ID As Long
On Error Resume Next
Do
ID = InputBox("Enter valid ID", "Student ID")
Loop Until ID >= 10000 And ID < 100000
On Error GoTo 0
strFile = "Student Questionnaire " & ID & ".xls"
If Val(Application.Version) < 12 Then
FileExtStr = ".xls": FileFormatNum = -4143
Else
FileExtStr = ".xls": FileFormatNum = 56
End If
Set objWShell = CreateObject("WScript.Shell")
strFolder = objWShell.SpecialFolders("Desktop")
ActiveWorkbook.SaveAs strFolder & "\" & strFile,
FileFormat:=FileFormatNum
Set objWShell = Nothing
End Sub

Regards,
Per

 

[Bob]

Per,

Thanks for putting together the modified code, especially in such a short
time span. I greatly appreciate it.

Regards,
Bob