Need help rewriting a macro

S

S Willingham

I have the following macro that names and saves my workbook.

Sub SaveWorkbookToFolder()
Dim CustomerName As String
Dim InvoiceNumber As String
Dim ProjectName As String
Dim SaveToPath As String
Dim userInput As String
Dim anyFilename As String

'Change A1 to the cell your QuoteName is in
'Change B1 to the cell your CustomerName is in
QuoteName = Range("E8").Value
CustomerName = Range("B6").Value
ProjectName = Range("E36").Value

'Change to the folder path need to be sure you have a \ at the end of path
SaveToPath = "C:\Documents and Settings\FaroTemplate\Desktop\Quotes\" & _
CustomerName & "\"

anyFilename = QuoteName & _
"_" & ProjectName & _
"_" & CustomerName & ".xls"

If Dir(SaveToPath & anyFilename) = "" Then

ActiveWorkbook.SaveAs Filename:=SaveToPath & anyFilename
Else

Select Case MsgBox _
("A file named: '" & anyFilename & " already exists in " & SaveToPath _
& vbCrLf & "What would you like to do?" & vbCrLf _
& "Overwrite the existing file? [Yes]" & vbCrLf _
& "Save file with a different name? [No]" & vbCrLf _
& "Cancel - do not save this file at this time. [Cancel]", _
vbYesNoCancel + vbExclamation + vbDefaultButton2, "Save Invoice To Folder ")

Case Is = vbYes

Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=SaveToPath & anyFilename
Application.DisplayAlerts = True

Case Is = vbNo


userInput = "dummy entry to make it work"

GetFileNameFromUser:
Do While userInput <> ""
anyFilename = InputBox$("Enter a new filename to use:", _
"Commission Manager", CustomerName & _
"_" & InvoiceNumber)
If Right(UCase(Trim(anyFilename)), 4) <> ".XLS" Then
anyFilename = anyFilename & ".xls"
End If
If ValidateFilename(anyFilename) <> "" Then

MsgBox _
"The filename you have entered is not a valid filename." _
& vbCrLf & _
"Filenames may not have any of these characters in them:" _
& vbCrLf & _
" \ / : * ? < > | " & Chr$(34) & vbCrLf _
& "Please provide a valid filename.", _
vbOKOnly, "Invalid Filename"
GoTo GetFileNameFromUser
End If
If Trim(UCase(anyFilename)) = ".XLS" Then

If MsgBox("You have chosen to Cancel the file save." & _
"Did you really intend to Cancel this operation?", _
vbYesNo + vbInformation, "Confirm Cancel") <> vbYes Then
GoTo GetFileNameFromUser
Else

anyFilename = ":* QUIT *:"
userInput = ""
End If
End If
If userInput <> "" Then

userInput = Dir(SaveToPath & anyFilename)
End If
Loop


If anyFilename <> ":* QUIT *:" Then

ActiveWorkbook.SaveAs Filename:=SaveToPath & anyFilename
End If

Case Else


Application.DisplayAlerts = False
ActiveWindow.Close
Application.DisplayAlerts = True

End Select
End If

End Sub



Private Function ValidateFilename(anyFilename As String) As String

Dim InvalidCharacterList As String
InvalidCharacterList = "\/:*?<>|" & Chr$(34)
Dim LC As Integer

ValidateFilename = ""
If Len(Trim(anyFilename)) = 0 Then
ValidateFilename = "EMPTY"
Exit Function
End If
anyFilename = Trim(anyFilename)
For LC = 1 To Len(anyFilename)
If InStr(InvalidCharacterList, Mid(anyFilename, LC, 1)) Then
ValidateFilename = Mid(anyFilename, LC, 1)
Exit Function
End If
Next

End Function

I have this macro that "sends" info from certain cells to a seperate workbook

Sub Quotelog()
'
' JobRecap Macro
' Macro recorded 3/11/2007 by FaroTemplate
'
Const RECAPWorkbookName = "JOB RECAP.xls"
Const RECAPWorksheetName = "Quote Log"
Const JobName = "Info sheet"
QuoteWorkbook = InputBox("Enter Quote Name")

LastRow = Workbooks(RECAPWorkbookName).Worksheets(RECAPWorksheetName). _
Range("A2:A1000").End(xlDown).Row

If LastRow = 65536 Then
If IsEmpty(Workbooks(RECAPWorkbookName).Worksheets(RECAPWorksheetName). _
Range("A2").Value) Then

Myrowoffset = 0
Else
Myrowoffset = 1
End If
Else
Myrowoffset = LastRow - 1
End If


'QuoteWorkbook = InputBox("Enter Job Name")


Workbooks(RECAPWorkbookName).Worksheets(RECAPWorksheetName). _
Range("A2").Offset(rowoffset:=Myrowoffset, columnoffset:=0) = _
Workbooks(RECAPWorkbookName).Worksheets(RECAPWorksheetName). _
Range("E8")

Workbooks(RECAPWorkbookName).Worksheets(RECAPWorksheetName). _
Range("A2").Offset(rowoffset:=Myrowoffset, columnoffset:=0) = _
Workbooks(QuoteWorkbook).Worksheets(JobName).Range("E8")

Workbooks(RECAPWorkbookName).Worksheets(RECAPWorksheetName). _
Range("B2").Offset(rowoffset:=Myrowoffset, columnoffset:=0) = _
Workbooks(QuoteWorkbook).Worksheets(JobName).Range("E10")

Workbooks(RECAPWorkbookName).Worksheets(RECAPWorksheetName). _
Range("C2").Offset(rowoffset:=Myrowoffset, columnoffset:=0) = _
Workbooks(QuoteWorkbook).Worksheets(JobName).Range("E12")

Workbooks(RECAPWorkbookName).Worksheets(RECAPWorksheetName). _
Range("D2").Offset(rowoffset:=Myrowoffset, columnoffset:=0) = _
Workbooks(QuoteWorkbook).Worksheets(JobName).Range("B22")

Workbooks(RECAPWorkbookName).Worksheets(RECAPWorksheetName). _
Range("E2").Offset(rowoffset:=Myrowoffset, columnoffset:=0) = _
Workbooks(QuoteWorkbook).Worksheets(JobName).Range("K20")

Workbooks(RECAPWorkbookName).Worksheets(RECAPWorksheetName). _
Range("F2").Offset(rowoffset:=Myrowoffset, columnoffset:=0) = _
Workbooks(QuoteWorkbook).Worksheets(JobName).Range("B34")

Workbooks(RECAPWorkbookName).Worksheets(RECAPWorksheetName). _
Range("G2").Offset(rowoffset:=Myrowoffset, columnoffset:=0) = _
Workbooks(QuoteWorkbook).Worksheets(JobName).Range("M14")

Workbooks(RECAPWorkbookName).Worksheets(RECAPWorksheetName). _
Range("H2").Offset(rowoffset:=Myrowoffset, columnoffset:=0) = _
Workbooks(QuoteWorkbook).Worksheets(JobName).Range("B47")



Workbooks(RECAPWorkbookName).Worksheets("Quote Log"). _
Columns("A:A").ColumnWidth = 32
Workbooks(RECAPWorkbookName).Worksheets("Quote Log"). _
Columns("B:B").ColumnWidth = 12
Workbooks(RECAPWorkbookName).Worksheets("Quote Log"). _
Columns("C:C").ColumnWidth = 26
Workbooks(RECAPWorkbookName).Worksheets("Quote Log"). _
Columns("D:D").ColumnWidth = 13
Workbooks(RECAPWorkbookName).Worksheets("Quote Log"). _
Columns("E:E").ColumnWidth = 12
Workbooks(RECAPWorkbookName).Worksheets("Quote Log"). _
Columns("F:F").ColumnWidth = 18
Workbooks(RECAPWorkbookName).Worksheets("Quote Log"). _
Columns("G:G").ColumnWidth = 22
Workbooks(RECAPWorkbookName).Worksheets("Quote Log"). _
Columns("H:H").ColumnWidth = 22

End Sub


When I activate the Quotelog macro I get a message box that prompts me to
enter the workbook name. Is there a way I can eliminate the naming step.
Can it be set to the Active workbook or can I duplicate the method used in
the file saving macro to generate a "name".

I am ultimatley trying to save some keystrokes Any ideas are appreciated.

Thanks

Steve
 
M

Mike

try this
InputBox ("Enter Job Name"), "SaveKeyStrokes", ActiveWorkbook.Name

S Willingham said:
I have the following macro that names and saves my workbook.

Sub SaveWorkbookToFolder()
Dim CustomerName As String
Dim InvoiceNumber As String
Dim ProjectName As String
Dim SaveToPath As String
Dim userInput As String
Dim anyFilename As String

'Change A1 to the cell your QuoteName is in
'Change B1 to the cell your CustomerName is in
QuoteName = Range("E8").Value
CustomerName = Range("B6").Value
ProjectName = Range("E36").Value

'Change to the folder path need to be sure you have a \ at the end of path
SaveToPath = "C:\Documents and Settings\FaroTemplate\Desktop\Quotes\" & _
CustomerName & "\"

anyFilename = QuoteName & _
"_" & ProjectName & _
"_" & CustomerName & ".xls"

If Dir(SaveToPath & anyFilename) = "" Then

ActiveWorkbook.SaveAs Filename:=SaveToPath & anyFilename
Else

Select Case MsgBox _
("A file named: '" & anyFilename & " already exists in " & SaveToPath _
& vbCrLf & "What would you like to do?" & vbCrLf _
& "Overwrite the existing file? [Yes]" & vbCrLf _
& "Save file with a different name? [No]" & vbCrLf _
& "Cancel - do not save this file at this time. [Cancel]", _
vbYesNoCancel + vbExclamation + vbDefaultButton2, "Save Invoice To Folder ")

Case Is = vbYes

Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=SaveToPath & anyFilename
Application.DisplayAlerts = True

Case Is = vbNo


userInput = "dummy entry to make it work"

GetFileNameFromUser:
Do While userInput <> ""
anyFilename = InputBox$("Enter a new filename to use:", _
"Commission Manager", CustomerName & _
"_" & InvoiceNumber)
If Right(UCase(Trim(anyFilename)), 4) <> ".XLS" Then
anyFilename = anyFilename & ".xls"
End If
If ValidateFilename(anyFilename) <> "" Then

MsgBox _
"The filename you have entered is not a valid filename." _
& vbCrLf & _
"Filenames may not have any of these characters in them:" _
& vbCrLf & _
" \ / : * ? < > | " & Chr$(34) & vbCrLf _
& "Please provide a valid filename.", _
vbOKOnly, "Invalid Filename"
GoTo GetFileNameFromUser
End If
If Trim(UCase(anyFilename)) = ".XLS" Then

If MsgBox("You have chosen to Cancel the file save." & _
"Did you really intend to Cancel this operation?", _
vbYesNo + vbInformation, "Confirm Cancel") <> vbYes Then
GoTo GetFileNameFromUser
Else

anyFilename = ":* QUIT *:"
userInput = ""
End If
End If
If userInput <> "" Then

userInput = Dir(SaveToPath & anyFilename)
End If
Loop


If anyFilename <> ":* QUIT *:" Then

ActiveWorkbook.SaveAs Filename:=SaveToPath & anyFilename
End If

Case Else


Application.DisplayAlerts = False
ActiveWindow.Close
Application.DisplayAlerts = True

End Select
End If

End Sub



Private Function ValidateFilename(anyFilename As String) As String

Dim InvalidCharacterList As String
InvalidCharacterList = "\/:*?<>|" & Chr$(34)
Dim LC As Integer

ValidateFilename = ""
If Len(Trim(anyFilename)) = 0 Then
ValidateFilename = "EMPTY"
Exit Function
End If
anyFilename = Trim(anyFilename)
For LC = 1 To Len(anyFilename)
If InStr(InvalidCharacterList, Mid(anyFilename, LC, 1)) Then
ValidateFilename = Mid(anyFilename, LC, 1)
Exit Function
End If
Next

End Function

I have this macro that "sends" info from certain cells to a seperate workbook

Sub Quotelog()
'
' JobRecap Macro
' Macro recorded 3/11/2007 by FaroTemplate
'
Const RECAPWorkbookName = "JOB RECAP.xls"
Const RECAPWorksheetName = "Quote Log"
Const JobName = "Info sheet"
QuoteWorkbook = InputBox("Enter Quote Name")

LastRow = Workbooks(RECAPWorkbookName).Worksheets(RECAPWorksheetName). _
Range("A2:A1000").End(xlDown).Row

If LastRow = 65536 Then
If IsEmpty(Workbooks(RECAPWorkbookName).Worksheets(RECAPWorksheetName). _
Range("A2").Value) Then

Myrowoffset = 0
Else
Myrowoffset = 1
End If
Else
Myrowoffset = LastRow - 1
End If


'QuoteWorkbook = InputBox("Enter Job Name")


Workbooks(RECAPWorkbookName).Worksheets(RECAPWorksheetName). _
Range("A2").Offset(rowoffset:=Myrowoffset, columnoffset:=0) = _
Workbooks(RECAPWorkbookName).Worksheets(RECAPWorksheetName). _
Range("E8")

Workbooks(RECAPWorkbookName).Worksheets(RECAPWorksheetName). _
Range("A2").Offset(rowoffset:=Myrowoffset, columnoffset:=0) = _
Workbooks(QuoteWorkbook).Worksheets(JobName).Range("E8")

Workbooks(RECAPWorkbookName).Worksheets(RECAPWorksheetName). _
Range("B2").Offset(rowoffset:=Myrowoffset, columnoffset:=0) = _
Workbooks(QuoteWorkbook).Worksheets(JobName).Range("E10")

Workbooks(RECAPWorkbookName).Worksheets(RECAPWorksheetName). _
Range("C2").Offset(rowoffset:=Myrowoffset, columnoffset:=0) = _
Workbooks(QuoteWorkbook).Worksheets(JobName).Range("E12")

Workbooks(RECAPWorkbookName).Worksheets(RECAPWorksheetName). _
Range("D2").Offset(rowoffset:=Myrowoffset, columnoffset:=0) = _
Workbooks(QuoteWorkbook).Worksheets(JobName).Range("B22")

Workbooks(RECAPWorkbookName).Worksheets(RECAPWorksheetName). _
Range("E2").Offset(rowoffset:=Myrowoffset, columnoffset:=0) = _
Workbooks(QuoteWorkbook).Worksheets(JobName).Range("K20")

Workbooks(RECAPWorkbookName).Worksheets(RECAPWorksheetName). _
Range("F2").Offset(rowoffset:=Myrowoffset, columnoffset:=0) = _
Workbooks(QuoteWorkbook).Worksheets(JobName).Range("B34")

Workbooks(RECAPWorkbookName).Worksheets(RECAPWorksheetName). _
Range("G2").Offset(rowoffset:=Myrowoffset, columnoffset:=0) = _
Workbooks(QuoteWorkbook).Worksheets(JobName).Range("M14")

Workbooks(RECAPWorkbookName).Worksheets(RECAPWorksheetName). _
Range("H2").Offset(rowoffset:=Myrowoffset, columnoffset:=0) = _
Workbooks(QuoteWorkbook).Worksheets(JobName).Range("B47")



Workbooks(RECAPWorkbookName).Worksheets("Quote Log"). _
Columns("A:A").ColumnWidth = 32
Workbooks(RECAPWorkbookName).Worksheets("Quote Log"). _
Columns("B:B").ColumnWidth = 12
Workbooks(RECAPWorkbookName).Worksheets("Quote Log"). _
Columns("C:C").ColumnWidth = 26
Workbooks(RECAPWorkbookName).Worksheets("Quote Log"). _
Columns("D:D").ColumnWidth = 13
Workbooks(RECAPWorkbookName).Worksheets("Quote Log"). _
Columns("E:E").ColumnWidth = 12
Workbooks(RECAPWorkbookName).Worksheets("Quote Log"). _
Columns("F:F").ColumnWidth = 18
Workbooks(RECAPWorkbookName).Worksheets("Quote Log"). _
Columns("G:G").ColumnWidth = 22
Workbooks(RECAPWorkbookName).Worksheets("Quote Log"). _
Columns("H:H").ColumnWidth = 22

End Sub


When I activate the Quotelog macro I get a message box that prompts me to
enter the workbook name. Is there a way I can eliminate the naming step.
Can it be set to the Active workbook or can I duplicate the method used in
the file saving macro to generate a "name".

I am ultimatley trying to save some keystrokes Any ideas are appreciated.

Thanks

Steve
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Help with this Macro 3
Need help modifying a macro 1
Need help modifying a macro 1
How to copy and paste a partial row (i.e. not the EntireRow) 5
Help With Input Box 3
stopping a macro 0
Returning the name of a deleted cell style 6
Need to IMPORT a Worksheet From another WorkBook 2

Top