Solved

Save File with Reference that will increment

Posted on 2014-02-11
38
299 Views
Last Modified: 2014-02-13
I need to save a file that will save with a reference but if that file/ref already exists I need the reference to increment by 1

So..... i.e.

I would like the file to save as activeworkbook.saveas "P:\Country\Client\ABC00001 110214.xlsm

[110214 being the current days date]

Then the next file

I would like the file to save as activeworkbook.saveas "P:\Country\Client\ABC00002 110214.xlsm

Thanks
0
Comment
Question by:Jagwarman
  • 19
  • 9
  • 9
  • +1
38 Comments
 
LVL 6

Expert Comment

by:alexgreen312
Comment Utility
You'll need to run it as a macro but here

http://www.vbaexpress.com/kb/getarticle.php?kb_id=1008

It should all be there for you
0
 
LVL 48

Expert Comment

by:Rgonzo1971
Comment Utility
HI,

pls try

Sub Macro()
myDate = "110214"
Idx = 1
On Error Resume Next
ExcelFile = Dir("P:\Country\Client\ABC????? " & myDate & ".xslm")
On Error GoTo 0
If ExcelFile <> "" Then
    Idx = CLng(Right(Split(ExcelFile, " ")(0), 5))
    Do While ExcelFile <> ""
        ExcelFile = Dir
        If CLng(Right(Split(ExcelFile, " ")(0), 5)) > Idx Then
            Idx = CLng(Right(Split(ExcelFile, " ")(0), 5))
        End If
    Loop
End If
Filename = "P:\Country\Client\ABC" & Format(Idx, "00000") & " " & myDate & ".xslm"
ActiveWorkbook.SaveAs Filename
End Sub

Open in new window

Regards
0
 
LVL 26

Expert Comment

by:MacroShadow
Comment Utility
How about this:
Sub Demo()

    Dim strFilePath As String, strFile As String
    Dim strMax As String, strFilename As String
    
    strFilePath = "P:\Country\Client\"
    
    strFile = Dir(strFilePath & "*xlsm")

    Do While strFile <> ""
        strMax = Mid(strFilePath, InStr(strFilePath, " ") - 5, 5)
        strFile = Dir
    Loop
    
    If strMax = "" Then strMax = "00000"
    
    strFilename = "ABC" & Format(strMax + 1, "00000") & " " & Format(Date, "DDMMYY") & ".xlsm"
    
    ActiveWorkbook.SaveAs strFilename
    
End Sub

Open in new window

0
 

Author Comment

by:Jagwarman
Comment Utility
Rgonzo1971 yours is coming up with Variable not defined in mydate, Idx, ExcelFile etc

can you help
0
 

Author Comment

by:Jagwarman
Comment Utility
MacroShadow, Your onesaved the original file ok but then when I saved another it wanted to save with the same name as the previous one so not incrementing.
0
 
LVL 48

Expert Comment

by:Rgonzo1971
Comment Utility
Hi

with Dims

Sub Macro1()
Dim myDate As String, ExcelFile As String, FileName As String
Dim Idx As Double
myDate = Format(Date, "ddmmyy")
Idx = 1
On Error Resume Next
ExcelFile = Dir("P:\Country\Client\ABC????? " & myDate & ".xslm")
On Error GoTo 0
If ExcelFile <> "" Then
    Idx = CLng(Right(Split(ExcelFile, " ")(0), 5))
    Do While ExcelFile <> ""
        ExcelFile = Dir
        If CLng(Right(Split(ExcelFile, " ")(0), 5)) > Idx Then
            Idx = CLng(Right(Split(ExcelFile, " ")(0), 5))
        End If
    Loop
End If
FileName = "P:\Country\Client\ABC" & Format(Idx, "00000") & " " & myDate & ".xslm"
ActiveWorkbook.SaveAs FileName
End Sub

Open in new window

Regards
0
 
LVL 26

Expert Comment

by:MacroShadow
Comment Utility
Sorry. Fixed version.

EDIT: Hopefully this time for real:)

Sub Demo()

    Dim strFilePath As String, strFile As String
    Dim intMax As String, strFilename As String
    
    strFilePath = "P:\Country\Client\"
    
    strFile = Dir(strFilePath & "*xlsm")

    Do While strFile <> ""
        intMax = CInt(Mid(strFile, InStr(strFile, " ") - 5, 5))
        strFile = Dir
    Loop
    
    If intMax = "" Then intMax = 0
    
    strFilename = "ABC" & Format(intMax + 1, "00000") & " " & Format(Date, "DDMMYY") & ".xlsm"
    
    ActiveWorkbook.SaveAs strFilename
    
End Sub

Open in new window

0
 

Author Comment

by:Jagwarman
Comment Utility
MacroShadow, Same as before....Your one saved the original file ok but then when I saved another it wanted to save with the same name as the previous one so not incrementing.
0
 

Author Comment

by:Jagwarman
Comment Utility
Rgonzo1971 it saves the file but then when I save next time it says A file named ABC00001 120214.xlsm already exists............

It should save the next file as ABC00002 120214.xlsm

Thanks
Regards
0
 
LVL 26

Expert Comment

by:MacroShadow
Comment Utility
I read your question again (and again and again...) and I don't understand what you are trying to do.

Are you trying to loop thru a folder and rename all existing files? Or are you trying to save the current workbook once for each existing file, or is it something else all together?
0
 
LVL 48

Expert Comment

by:Rgonzo1971
Comment Utility
Hi,

I forgot to add one

Sub Macro1()
Dim myDate As String, ExcelFile As String, FileName As String
Dim Idx As Double
myDate = Format(Date, "ddmmyy")
Idx = 0
On Error Resume Next
ExcelFile = Dir("P:\Country\Client\ABC????? " & myDate & ".xslm")
On Error GoTo 0
If ExcelFile <> "" Then
    Idx = CLng(Right(Split(ExcelFile, " ")(0), 5))
    Do While ExcelFile <> ""
        ExcelFile = Dir
        If CLng(Right(Split(ExcelFile, " ")(0), 5)) > Idx Then
            Idx = CLng(Right(Split(ExcelFile, " ")(0), 5))
        End If
    Loop
End If
FileName = "P:\Country\Client\ABC" & Format(Idx+1, "00000") & " " & myDate & ".xslm"
ActiveWorkbook.SaveAs FileName
End Sub

Open in new window

Regards
0
 

Author Comment

by:Jagwarman
Comment Utility
MacroShadow

appreciate the help. In answer to your question......

Lets call the file with the Macro in 'Master copy' and all sheets are blank.

We enter data into sheets on the 'Master copy' and when we save that file it saves as ABC00001 110214.xlsm.  So the 'Master copy' is as it was originally, all sheets are blank.
When we open 'Master copy' all sheets are blank and we enter data into sheets on the 'Master copy' and then when we save that file it saves as ABC00002 110214.xlsm.

Hope this helps.
0
 
LVL 26

Expert Comment

by:MacroShadow
Comment Utility
Got it.

Sub Demo()

    Dim strFilePath As String, strFile As String, strDate As String
    Dim intMax As Integer, strFilename As String
    Dim blnFileExists As Boolean

    strFilePath = "P:\Country\Client\"
    strDate = Format(Date, "DDMMYY")
    intMax = 0
    strFile = Dir(strFilePath & "ABC*" & strDate & ".xlsm")

    Do While strFile <> ""
        intMax = CInt(Mid(strFile, InStr(strFile, " ") - 5, 5))

        strFilename = "ABC" & Format(intMax + 1, "00000") & " " & strDate & ".xlsm"

        Dim fso As Object
        Set fso = CreateObject("Scripting.FileSystemObject")

        Do While fso.fileexists(strFilePath & strFilename) = True
            intMax = intMax + 1
            strFilename = "ABC" & Format(intMax, "00000") & " " & strDate & ".xlsm"
        Loop
        
        Set fso = Nothing

        strFile = Dir

    Loop

    ActiveWorkbook.saveas Filename:=strFilePath & strFilename

End Sub

Open in new window

0
 

Author Comment

by:Jagwarman
Comment Utility
Quite bizzare MacroShadow.

This time it is saving the file as client.xlsm.
0
 

Author Comment

by:Jagwarman
Comment Utility
MacroShadow

even more bizzare, it is working now.

I will test it again tomorrow.

Regards
0
 

Author Comment

by:Jagwarman
Comment Utility
there is some very odd stuff going on here. Now that I have put the macro in the ctual file it falls over on the line

ActiveWorkbook.saveas Filename:=strFilePath & strFilename


Method save as object workbook failed
0
 
LVL 26

Expert Comment

by:MacroShadow
Comment Utility
I tested the code and it worked fine.

Is the actual file a macro-enabled file (.xlsm)?
0
 

Author Comment

by:Jagwarman
Comment Utility
yes the actual file is a macro enabled file.

Regards
0
 

Author Comment

by:Jagwarman
Comment Utility
Rgonzo1971 did you have any additional thoughts?
0
Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

 
LVL 48

Expert Comment

by:Rgonzo1971
Comment Utility
Do you have the same error

with my code posted on 2014-02-12 at 13:17:03

Regards
0
 

Author Comment

by:Jagwarman
Comment Utility
When I try it on my test file it falls over at 'ActiveWorkbook.saveas Filename:=strFilePath & strFilename

Method save as object workbook failed

If I then take it back to
strFilename = "ABC" & Format(intMax + 1, "00000") & " " & strDate & ".xlsm" and continue to run it from there it works.


When I try in in my actual file [macro enabled] it falls over at 'intMax = CInt(Mid(strFile, InStr(strFile, " ") - 5, 5))'  

Invalid procedure call or argument

If I then move on to
 
strFilename = "ABC" & Format(intMax + 1, "00000") & " " & strDate & ".xlsm" and continue to run it from there it works.


This is so very frustrating as it is so near.
0
 

Author Comment

by:Jagwarman
Comment Utility
Hi Rgonzo1971

It's very odd I can't find your post  [ 2014-02-12 at 13:17:03]  but I can find Posted on 2014-02-12 at 04:17:03 and I am sure I posted a reply to that one, However, at this point 'If CLng(Right(Split(ExcelFile, " ")(0), 5)) > Idx Then' I get the error 'Subscript out of Range'

Regards
0
 
LVL 48

Expert Comment

by:Rgonzo1971
Comment Utility
What is the value of ExcelFile at this point?
0
 

Author Comment

by:Jagwarman
Comment Utility
Sorry Rgonzo, what does that mean?
0
 

Author Comment

by:Jagwarman
Comment Utility
what is also interesting Rgonzo1971 is that the initial save works but saves the file as ABC00002 ddmmyy.xlsm  not ABC00001 but it's the following time when I want to save that it falls over. as an FYI I have called my test file book1 and after the initial save I open book1 again and run that to save as ABC00002 etc. I am not trying to save the file that was saved as ABC00001 to save it again.

hope this info helps
0
 
LVL 48

Expert Comment

by:Rgonzo1971
Comment Utility
Try this code



Sub Macro1()
Dim myDate As String, ExcelFile As String, FileName As String
Dim Idx As Double
myDate = Format(Date, "ddmmyy")
Idx = 0
On Error Resume Next
ExcelFile = Dir("P:\Country\Client\ABC????? " & myDate & ".xslm")
On Error GoTo 0
If ExcelFile <> "" Then
    MsgBox ExcelFile
    Idx = CLng(Right(Split(ExcelFile, " ")(0), 5))
    Do While ExcelFile <> ""
        ExcelFile = Dir
        If CLng(Right(Split(ExcelFile, " ")(0), 5)) > Idx Then
            Idx = CLng(Right(Split(ExcelFile, " ")(0), 5))
        End If
    Loop
End If
FileName = "P:\Country\Client\ABC" & Format(Idx+1, "00000") & " " & myDate & ".xslm"
ActiveWorkbook.SaveAs FileName
End Sub

Open in new window

0
 

Author Comment

by:Jagwarman
Comment Utility
Rgonzo1971 that comes up with the MsgBox stating ABC00002 but 2 already exists it then falls over at Idx = CLng(Right(Split(ExcelFile, " ")(0), 5))....Subscript out of range.

Regards
0
 
LVL 48

Expert Comment

by:Rgonzo1971
Comment Utility
That was intended

pls try

what are the 2 messages?

Sub Macro1()
Dim myDate As String, ExcelFile As String, FileName As String
Dim Idx As Double
myDate = Format(Date, "ddmmyy")
Idx = 0
On Error Resume Next
ExcelFile = Dir("P:\Country\Client\ABC????? " & myDate & ".xslm")
On Error GoTo 0
If ExcelFile <> "" Then
    MsgBox "Part1: " & Split(ExcelFile, " ")(0)  
     MsgBox "Part2: " & Split(ExcelFile, " ")(1)
    Idx = CLng(Right(Split(ExcelFile, " ")(0), 5))
    Do While ExcelFile <> ""
        ExcelFile = Dir()
        If CLng(Right(Split(ExcelFile, " ")(0), 5)) > Idx Then
            Idx = CLng(Right(Split(ExcelFile, " ")(0), 5))
        End If
    Loop
End If
FileName = "P:\Country\Client\ABC" & Format(Idx+1, "00000") & " " & myDate & ".xslm"
ActiveWorkbook.SaveAs FileName
End Sub

Open in new window

0
 
LVL 26

Expert Comment

by:MacroShadow
Comment Utility
Sorry to interfere ...

In my code what is the value of strFilePath & strFilename at the time of the error?

To find the answer to my question:
1. Open the immediate window (Ctrl+G)
2. In the immediate window type ?strFilePath & strFilename
3. Hit enter

What is the value you get?
0
 

Author Comment

by:Jagwarman
Comment Utility
Part1: ABC0002
Part2: 130214.xlsm [you have xslm in macro so I changes to xlsm]

then it falls over at If CLng(Right(Split(ExcelFile, " ")(0), 5)) > Idx Then......

Subscript out of range.
0
 

Author Comment

by:Jagwarman
Comment Utility
Hi MacroShadow

you are defo not interfering......

?strFilePath & strFilename
Z:\Test files\JK\

But what is interesting is it is sporadic. Sometimes it works.

it is falling over now at

with method Saveas of object workbook failed
0
 
LVL 48

Assisted Solution

by:Rgonzo1971
Rgonzo1971 earned 250 total points
Comment Utility
Hi,

Now I think I've got this error fixed

pls try

Sub Macro1()
Dim myDate As String, ExcelFile As String, FileName As String
Dim Idx As Double
myDate = Format(Date, "ddmmyy")
Idx = 0
On Error Resume Next
ExcelFile = Dir("P:\Country\Client\ABC????? " & myDate & ".xslm")
On Error GoTo 0
If ExcelFile <> "" Then
    Idx = CLng(Right(Split(ExcelFile, " ")(0), 5))
    Do While ExcelFile <> ""
        If CLng(Right(Split(ExcelFile, " ")(0), 5)) > Idx Then
            Idx = CLng(Right(Split(ExcelFile, " ")(0), 5))
        End If
        ExcelFile = Dir()
    Loop
End If
FileName = "P:\Country\Client\ABC" & Format(Idx+1, "00000") & " " & myDate & ".xslm"
ActiveWorkbook.SaveAs FileName
End Sub 

Open in new window

Regards
0
 
LVL 26

Expert Comment

by:MacroShadow
Comment Utility
Does this work?

Sub Demo()

    Dim strFilePath As String, strFile As String, strDate As String
    Dim intMax As Integer, strFilename As String
    Dim fso As Object

    strFilePath = "P:\Country\Client\"
    strDate = Format(Date, "DDMMYY")
    strFile = Dir(strFilePath & "ABC*" & strDate & ".xlsm")
    intMax = CInt(Mid(strFile, InStr(strFile, " ") - 5, 5))
    
    If intMax < 1 Then intMax = 1
    strFilename = "ABC" & Format(intMax + 1, "00000") & " " & strDate & ".xlsm"

    Do While strFile <> ""
        Set fso = CreateObject("Scripting.FileSystemObject")
        Do While fso.fileexists(strFilePath & strFilename) = True
            intMax = intMax + 1
            strFilename = "ABC" & Format(intMax, "00000") & " " & strDate & ".xlsm"
        Loop
        Set fso = Nothing
        strFile = Dir
    Loop

    ActiveWorkbook.saveas Filename:=strFilePath & strFilename

End Sub

Open in new window

0
 

Author Comment

by:Jagwarman
Comment Utility
It works fine if there is already a file with ABC00001 already there otherwise it falls over at

intMax = CInt(Mid(strFile, InStr(strFile, " ") - 5, 5))

Invalid procedure call or argument
0
 
LVL 48

Expert Comment

by:Rgonzo1971
Comment Utility
And how about mine?
0
 
LVL 26

Accepted Solution

by:
MacroShadow earned 250 total points
Comment Utility
Ok, so this should take care of that.

Sub Demo()

    Dim strFilePath As String, strFile As String, strDate As String
    Dim intMax As Integer, strFilename As String
    Dim fso As Object

    strFilePath = "P:\Country\Client\"
    strDate = Format(Date, "DDMMYY")
    strFile = Dir(strFilePath & "ABC*" & strDate & ".xlsm")

    If strFile <> "" Then
        intMax = CInt(Mid(strFile, InStr(strFile, " ") - 5, 5))
    End If
    
    If intMax < 1 Then intMax = 1
    strFilename = "ABC" & Format(intMax + 1, "00000") & " " & strDate & ".xlsm"

    Do While strFile <> ""
        Set fso = CreateObject("Scripting.FileSystemObject")
        Do While fso.fileexists(strFilePath & strFilename) = True
            intMax = intMax + 1
            strFilename = "ABC" & Format(intMax, "00000") & " " & strDate & ".xlsm"
        Loop
        Set fso = Nothing
        strFile = Dir
    Loop

    ActiveWorkbook.saveas Filename:=strFilePath & strFilename

End Sub
                                            

Open in new window

0
 

Author Closing Comment

by:Jagwarman
Comment Utility
both MacroShadow and Rgonzo1971 have worked effortlessly to help me resolve this one and both of their solutions are brilliant. I can't really say which one is the better solution but the Experts system forces me to choose one over the other. so, even though my tick is is one of them, Thank you both I am giving you both 250 points. If I had my choice you would both get 500
0
 
LVL 26

Expert Comment

by:MacroShadow
Comment Utility
Thank you.
0

Featured Post

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

Approximate matching with VLOOKUP and MATCH seems to me to be a greatly under-used technique, and one which is vital for getting good performance out of large lookups. Until recently I would always have advised using an exact match for simplicity an…
This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

763 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now