New VBA Code needed

[keilah]

Hi

Need some assistance....in amending or even re writing the following code so that each time i save the workbook from July 07 to Aug 07......etc......rolling forward.....so aug 07 to sept 07 etc...

the macro refers to the current active workbook and runs......doing it origianl task, this is the field that i need to change on the file save as......to the next month

Workbooks("RevalComparisonModelJuly07test.xls").Activate

cannont seem to get it to work.....still trying




Sub ResertDataFields()

Dim strDate As String, strFile As String
strFile = "RevalComparisonModelJuly07test"
strDate = InputBox$("Enter save date - e.g. Aug07")
ActiveWorkbook.SaveAs ActiveWorkbook.Path & "R:\PricingModel-June07 to date\" & strFile & strDate & ".xls"
ResertDataFields ActiveWorkbook

Application.ScreenUpdating = False

Workbooks("Monthly Income Report.xls").Activate
Worksheets("Monthly Income Report").Select
Range("A1:N220").Select
Selection.Copy
Workbooks("RevalComparisonModelJuly07test.xls").Activate
Worksheets("IncomeReport-").Select
Range("A5:N220").Select
ActiveSheet.Paste

Application.ScreenUpdating = True

End Sub

CROSS-POSTED: http://www.experts-exchange.com/Q_22791433.html

[Oorang]

Would this do the trick?
Sub Example()
Const sFileNotFound_c As String = "False"
Dim sFilePath As String
sFilePath = GetCurrentWBPath("G:")
If sFilePath = sFileNotFound_c Then
VBA.MsgBox "File not found."
Else
VBA.MsgBox "Your file is: " & sFilePath
End If
End Sub
Private Function GetCurrentWBPath(ByVal Folder As String) As String
Const sPrefix_c As String = "RevalComparisonModel"
Const sSuffix_c As String = "test.xls"
Const sFormat_c As String = "mmmyy"
Const sBckSlsh_c As String = "\"
Const lOneChr_c As Long = 1
Const sFlNtFnd_c As String = "False"
Dim fso As Object
Dim sFileName As String
sFileName = sPrefix_c & VBA.Format$(VBA.Date, sFormat_c) & sSuffix_c
If VBA.Right(Folder, lOneChr_c) <> sBckSlsh_c Then
Folder = Folder & sBckSlsh_c
End If
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
If fso.FileExists(Folder & sFileName) Then
GetCurrentWBPath = Folder & sFileName
Else
If VBA.MsgBox("Cannot find """ & Folder & sFileName & """. Do you want to try to find it yourself?", vbQuestion + vbYesNo, "File Not Found") = vbYes Then
GetCurrentWBPath = Excel.Application.GetOpenFilename("Microsoft Excel Files (*.xl*), *.*xl", Title:="Select Current File:")
Else
GetCurrentWBPath = sFlNtFnd_c
End If
End If
Set fso = Nothing
End Function