Saving as a specifc file name in increments

[npereira]

Hi all,

I have an invoice worksheet that I keep adding stuff to to make it wor
as simply as possible. I have a Text box in the invoice sheet that
enter manualy a invoice #. Then I save the file with the name as th
invoice number, ex: 00040.xls

Now, I would like to not have to manualy put the invoice number in th
invoice and save it as that name.

Is there a way that when save-as my invoice.xls, that it looks in th
same directory and saves itself as the next invoice # (file 0040.xl
exist? then save as 0041.xls).

Let me know if this is remotely possible.

Regards,

Nelso

 

[K Dales]

Possible, but tricky since you would need to first loop through all the
files, then extract the digits from the file name, then convert to numbers,
then sort! But I will give it a try. Here is a function that will take a
folder path as a parameter (e.g. "C:\My Documents\Invoices") and will return
the next invoice number (as a String) in the sequence of files in that path.
You could use the result to fill in the new invoice number in the current
file, and then to save the file (e.g. ThisWorkbook.SaveAs FPath & "\" &
NewInvoice(FPath) & ".xls"):

Function NewInvoice(FPath As String) As String
' FPath is the path to the folder for saving invoices

Dim ListRange As Range, FileName As String
Dim FilesFound As Integer, FoundFile As String
Dim OldNumber As Integer, NewNumber As String

Set ListRange = Sheets("Sheet2").Range("A1")
FilesFound = 0

FileName = Dir(FPath & "\*.xls")

' Loop through files found in the specified folder
While Not (FileName = "")
FoundFile = Replace(FileName, ".xls", "")
' Strip the .xls; see if this is an invoice number
If IsNumeric(FoundFile) Then
FilesFound = FilesFound + 1
' Add to list (converting to numeric)
ListRange.Offset(FilesFound - 1, 0) = Val(FoundFile)
End If
FileName = Dir
Wend

' Find the old number, set the new number value
If FilesFound = 0 Then
NewNumber = "0001"
Else
With ListRange
If FilesFound > 1 Then .Sort .Cells(1, 1), xlAscending, , , , , , xlNo
OldNumber = .Offset(FilesFound - 1, 0).Range("A1").Value
NewNumber = Format(Val(OldNumber + 1), "0000")
End With
End If

NewInvoice = NewNumber
ListRange.EntireColumn.Clear
Set ListRange = Nothing

End Function