Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Worksheet Functions > Need help rewriting a macro
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.worksheet.functions
external usenet poster
  
Posts: 30
Default Need help rewriting a macro
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(RECAPWorks heetName). _
Range("A2:A1000").End(xlDown).Row

If LastRow = 65536 Then
If IsEmpty(Workbooks(RECAPWorkbookName).Worksheets(RE CAPWorksheetName). _
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(RECAPWorks heetName). _
Range("A2").Offset(rowoffset:=Myrowoffset, columnoffset:=0) = _
Workbooks(RECAPWorkbookName).Worksheets(RECAPWorks heetName). _
Range("E8")

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

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

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

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

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

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

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

Workbooks(RECAPWorkbookName).Worksheets(RECAPWorks heetName). _
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
Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.worksheet.functions
external usenet poster
  
Posts: 3,101
Default Need help rewriting a macro
try this
InputBox ("Enter Job Name"), "SaveKeyStrokes", ActiveWorkbook.Name

"S Willingham" wrote:

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(RECAPWorks heetName). _
Range("A2:A1000").End(xlDown).Row

If LastRow = 65536 Then
If IsEmpty(Workbooks(RECAPWorkbookName).Worksheets(RE CAPWorksheetName). _
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(RECAPWorks heetName). _
Range("A2").Offset(rowoffset:=Myrowoffset, columnoffset:=0) = _
Workbooks(RECAPWorkbookName).Worksheets(RECAPWorks heetName). _
Range("E8")

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

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

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

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

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

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

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

Workbooks(RECAPWorkbookName).Worksheets(RECAPWorks heetName). _
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
Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Hybrid Mode Hybrid Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
My excel macro recorder no longer shows up when recording macro jack Excel Discussion (Misc queries) 1 February 5th 07 09:31 PM
My excel macro recorder no longer shows up when recording macro jack Excel Discussion (Misc queries) 3 February 5th 07 08:22 PM
using a cell value to control a counter inside a macro and displaying macro value ocset Excel Worksheet Functions 1 September 10th 06 05:32 AM
Rewriting a formula... Roz Excel Discussion (Misc queries) 3 January 6th 06 04:08 PM
Macro needed to Paste Values and prevent Macro operation thunderfoot Excel Discussion (Misc queries) 0 June 10th 05 03:38 PM


All times are GMT +1. The time now is 10:40 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement