Save Version to Save Next Consecutive Number|VBA & Macros|Excel Forum|My Online Training Hub

I have a VBA code designed to save as a new version,  It does work, however I need herlp with a small tweak.  My current file (I am a developer) is v158.  So basically, I want this macro to save the file with the same exact file name and extension, except increase the number by 1.  So my file would keep the same name and be v159.  Now, when I used it, it came out as v2.  When I was at v2, I did it as v002, so technichally there was no V2 for the macro to recognize in my folder, as I wanted all versions to remain sequentially.  I also want the file to be saved in the same folder where the active file I am using is located.  This is a macro I would use constantly, so it would be in my personal workbook, rather than within the workbook I am using.

<CODE>

Sub SaveNewVersion()
'PURPOSE: Save file, if already exists add a new version indicator to filename

Dim FolderPath As String
Dim myPath As String
Dim SaveName As String
Dim SaveExt As String
Dim VersionExt As String
Dim Saved As Boolean
Dim x As Long

TestStr = ""
Saved = False
x = 2

'Version Indicator (change to liking)
VersionExt = " v"

'Pull info about file
On Error GoTo NotSavedYet
myPath = ActiveWorkbook.FullName
myfilename = Mid(myPath, InStrRev(myPath, "\") + 1, InStrRev(myPath, ".") - InStrRev(myPath, "\") - 1)
FolderPath = Left(myPath, InStrRev(myPath, "\"))
SaveExt = "." & Right(myPath, Len(myPath) - InStrRev(myPath, "."))
On Error GoTo 0

'Determine Base File Name
If InStr(1, myfilename, VersionExt) > 1 Then
myArray = Split(myfilename, VersionExt)
SaveName = myArray(0)
Else
SaveName = myfilename
End If

'Test to see if file name already exists
If FileExist(FolderPath & SaveName & SaveExt) = False Then
ActiveWorkbook.SaveAs FolderPath & SaveName & SaveExt
Exit Sub
End If

'Need a new version made
Do While Saved = False
If FileExist(FolderPath & SaveName & VersionExt & x & SaveExt) = False Then
ActiveWorkbook.SaveAs FolderPath & SaveName & VersionExt & x & SaveExt
Saved = True
Else
x = x + 1
End If
Loop

'New version saved
MsgBox "New file version saved (version " & x & ")"

Exit Sub

'Error Handler
NotSavedYet:
MsgBox "This file has not been initially saved. " & _
"Cannot save a new version!", vbCritical, "Not Saved To Computer"

End Sub
Function FileExist(FilePath As String) As Boolean
'PURPOSE: Test to see if a file exists or not

Dim TestStr As String

'Test File Path (ie "C:\Users\Chris\Desktop\Test\book1.xlsm")
On Error Resume Next
TestStr = Dir(FilePath)
On Error GoTo 0

'Determine if File exists
If TestStr = "" Then
FileExist = False
Else
FileExist = True
End If

End Function

</CODE>