Add a sequence to the workbook if the same name is found when saving

[sofas]

Hello. I use the following code to save a specific sheet in a folder in the same path as the main workbook. It works fine for me. But I'm looking for some modifications
1) It is saved in Partition C in a specific folder, let it be “test”, if it does not exist, it is created and the workbook is saved inside it.
2) In some cases, the file names are identical. If the same name is found, a sequence must be added to the new file while keeping the oldest one without deleting it.

Sub Save_folder_Excel2()
Dim WS As Worksheet: Set WS = Sheet1
Dim path As String, folderName As String, Fname As String, Client As String
Dim shape As Excel.shape, rng As Range
Client = [D3].Value
path = ThisWorkbook.path & "\"
On Error Resume Next
    If Len([D3].Value) = 0 Then: Exit Sub
  
With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
folderName = "Client STG"
MkDir path & folderName
Fname = folderName & "\" & Client
WS.Copy
    Set rng = [B1:F22]
    With rng
        .Value = .Value
        .Validation.Delete
    End With
    For Each shape In ActiveSheet.Shapes
            shape.Delete
    Next
Application.ActiveWorkbook.SaveAs Filename:=path & Fname & ".xlsx", FileFormat:=51
ActiveWorkbook.Close
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
On Error GoTo 0
MsgBox "done" & vbLf & vbLf & path & _
      "", vbInformation, folderName
End Sub

 

[sofas]

Welcome.
Is there any suggestion to implement this?

 

[sofas]

Please help with the sequence of workbook numbers

 

[Alex Blakenburg]

The easiest way would be to add a date and time stamp to your filename.
If you want to use a version number then this one line:

Application.ActiveWorkbook.SaveAs Filename:=path & Fname & ".xlsx", FileFormat:=51

Will need to be replaced with quite a bit of code. You can find that code here:

VBA Code To Save As A New Version If File Already Exists

Learn how you can automatically create new file names with a version control extension (ie v2). You will definitely want to add this code to your PowerPoint, Word, Excel personal macro files!

www.thespreadsheetguru.com

On that page you will need the code:
• Function FileExist(FilePath As String) As Boolean
• Sub SaveNewVersion_Excel()
To SaveNewVersion in the dimension section add these lines
Dim TestStr As String
Dim myFileName As String
Dim myArray As Variant

And change this line myPath = to be

myPath = path & Fname & ".xlsx",

 

[sofas]

Thank you. I searched on the internet and found some solutions that I tried to modify to suit my file. Fortunately, I succeeded. This is my code after modification
I appreciate your continued support. Thank you very much

The easiest way would be to add a date and time stamp to your filename.
If you want to use a version number then this one line:

Application.ActiveWorkbook.SaveAs Filename:=path & Fname & ".xlsx", FileFormat:=51

Will need to be replaced with quite a bit of code. You can find that code here:

VBA Code To Save As A New Version If File Already Exists

Learn how you can automatically create new file names with a version control extension (ie v2). You will definitely want to add this code to your PowerPoint, Word, Excel personal macro files!

www.thespreadsheetguru.com

On that page you will need the code:
• Function FileExist(FilePath As String) As Boolean
• Sub SaveNewVersion_Excel()
To SaveNewVersion in the dimension section add these lines
Dim TestStr As String
Dim myFileName As String
Dim myArray As Variant

And change this line myPath = to be

myPath = path & Fname & ".xlsx",

Sub SaveFile_Excel()
Dim WS As Worksheet: Set WS = Sheet1
Dim path As String, Client As String, rng As Range
Dim MyFolder As String
'file name
Client = WS.[D3].Value
 With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
On Error Resume Next
    
'***********'Saves the file in the same path as the main workbook*********

'Name of the saving folder. Modify it to suit you

'MyFolder = "the documents"
 
 'Path = Application.ActiveWorkbook.Path & "\" & MyFolder

'*************To save the file in a partition of your choice*************

 path = "D:\Sales invoices"

'Create the folder if it is not found

If Dir(path, vbDirectory) = "" Then MkDir path
  Cpt = Dir(path & "\" & Client & "*")
 
  WS.Copy
'Convert equations to values in the specified range
Set rng = [B1:F22]
    With rng
        .Value = .Value: .Validation.Delete
        
'Delete buttons
For Each shp In ActiveSheet.shps
          shp.Delete
    Next
 End With
  'File name sequence
  F = 0
  Do While Cpt <> ""
    F = F + 1
    Cpt = Dir
  Loop
  'Save the file in the following path
  Application.ActiveWorkbook.SaveAs Filename:=path & "\" & Client & "_" & F + 1 & ".xlsx", FileFormat:=51
 
'(PDF)' to save the file in
'   Application.ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _
'        Filename:=Path & "\" & Client & "_" & F + 1
 
'Close the workbook
ActiveWorkbook.Close
DisplayAlerts = True
    .ScreenUpdating = True
End With

MsgBox "done" & vbLf & vbLf & path & _
      "", vbInformation, "File No :" & " " & " " & Client & F + 1

End Sub

 

[Alex Blakenburg]

Glad you found something that works for you, and thanks for posting what you finished up using.

 

[Alex Blakenburg]

I had a bit more of a look and your version and the one I gave you a like to, count the number of files already in the folder. This means that if you delete any of the older versions the version number will get out of sync and not use the latest no.
If you are happy to try another version then replace this code:

  'File name sequence
  F = 0
  Do While Cpt <> ""
    F = F + 1
    Cpt = Dir
  Loop
  'Save the file in the following path
  Application.ActiveWorkbook.SaveAs Filename:=path & "\" & Client & "_" & F + 1 & ".xlsx", FileFormat:=51

With this code:

  'File name sequence
    Dim sVers As String
    Dim VersionNo As Long, MaxVersionNo As Long
    Dim i As Long

    Do While Cpt <> ""
        sVers = Right(Left(Cpt, InStr(Cpt, ".xls") - 1), 4)
        VersionNo = 0
        For i = Len(sVers) - 1 To 1 Step -1
            If IsNumeric(Right(sVers, i)) Then
                VersionNo = Val(Right(sVers, i))
                Exit For
            End If
        Next i
        If MaxVersionNo < VersionNo Then MaxVersionNo = VersionNo
        Cpt = Dir
    Loop

  'Save the file in the following path
  Application.ActiveWorkbook.SaveAs Filename:=path & "\" & Client & "_" & MaxVersionNo + 1 & ".xlsx", FileFormat:=51

 

[sofas]

I had a bit more of a look and your version and the one I gave you a like to, count the number of files already in the folder. This means that if you delete any of the older versions the version number will get out of sync and not use the latest no.
If you are happy to try another version then replace this code:

  'File name sequence
  F = 0
  Do While Cpt <> ""
    F = F + 1
    Cpt = Dir
  Loop
  'Save the file in the following path
  Application.ActiveWorkbook.SaveAs Filename:=path & "\" & Client & "_" & F + 1 & ".xlsx", FileFormat:=51

With this code:

  'File name sequence
    Dim sVers As String
    Dim VersionNo As Long, MaxVersionNo As Long
    Dim i As Long

    Do While Cpt <> ""
        sVers = Right(Left(Cpt, InStr(Cpt, ".xls") - 1), 4)
        VersionNo = 0
        For i = Len(sVers) - 1 To 1 Step -1
            If IsNumeric(Right(sVers, i)) Then
                VersionNo = Val(Right(sVers, i))
                Exit For
            End If
        Next i
        If MaxVersionNo < VersionNo Then MaxVersionNo = VersionNo
        Cpt = Dir
    Loop

  'Save the file in the following path
  Application.ActiveWorkbook.SaveAs Filename:=path & "\" & Client & "_" & MaxVersionNo + 1 & ".xlsx", FileFormat:=51

A really important note that I did not notice before I tried your suggestion and it works well

 

[Alex Blakenburg]

Glad you found it useful. Appreciate you being open to another option when you thought you already had it sorted.