Unique document numbering

[KJH64]

Hello all
Its been a while since I have needed to post but this one has me stumped.
I have searched through archives over the past few days and cannot find help that exactly fits this problem.

I have created a template for a form that will be used many times a day. The idea is that each use of the form will generate a unique number (ie serial number) eg Y2001, Y2002 etc.
I have tried the following coding to change the serial number by one each time the form is opened (which is part of the problem);

Private Sub workbook_open()
Sheets("Permit to Work PG 1").Range("C2").Value = Sheets("Permit to Work PG 1").Range("C2").Value + 1
End Sub

However when I go to re-access the file for whatever reason, the serial number changes by 1.
It needs to remain fixed once used for that unique file.

The problem is that creating the form from the template and saving it as an .xls means the template does not save and therefore the serial number in the template does not increment for the next use.

The next part of the problem is once the form filled out it is to be saved with that unique number and the date in the filename to identify it.

Any suggestions will be greatly appreciated, thanks.

Ken

 

[KJH64]

Since my last reply I went and checked out the link. This is what I have come up with but similar to my problem before it errors when i go to saveme.(bolded line)


Option Explicit
Const PERMITtoWORKpg1 As String = "Sheet1"
'Jerry Beaucaire, 9/4/2011
'Self-enclosed incrementing invoice numbers
'from a template, multi-user compatible

Private Sub Workbook_BeforeSave _
(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim NewVal As Long

With Sheets(PERMITtoWORKpg1) 'the sheet with the invoice number on it
If .Range("AA1") = "" Then 'the doublecheck cell
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False

'reopen the template
Workbooks.Open Filename:= _
"C:\Documents and Settings\kjhuntle\Application Data\Microsoft\Templates\Permit to Work.xlt", Editable:=True

With ActiveWorkbook.Sheets(PERMITtoWORKpg1) 'update the template's current inv number
.Range("C2").Value = .Range("C2").Value + 1
NewVal = .Range("C2").Value 'remember the new number
End With
ActiveWorkbook.Close True 'close the template, save changes

.Range("C2").Value = NewVal 'put new number into current workbook
.Range("AA1") = "Incremented" 'flag the doublecheck cell
Application.ScreenUpdating = True
Application.EnableEvents = True
End If
End With

'normal save continues from here...
End Sub
Private Sub workbook_open()

With Sheets("PERMITtoWORKpg1")
If .Range("AA1") = "" Then .Range("C2").Value = .Range("C2").Value + 1
End With

End Sub

'This next macro will keep the user from trying to print
'the invoice before it receives a permanent inv number

Private Sub Workbook_BeforePrint(Cancel As Boolean)
If Sheets(PERMITtoWORKpg1).Range("AA1") = "" Then
MsgBox "You must save the workbook before printing is allowed."
Cancel = True
End If
End Sub

 

[KJH64]

Using that code i just posted, I indented the 'With' statement and it did not error, however the subsequent documents created did not increment by one when saved. Ahhh the frustration. Too late in the day for me I'm afraid.

 

[KJH64]

Solved my own error again. Persistance pays off. I removed the 'Workbook Open' macro and still did not solve it. Then I realised it was not updating and incrementing the xlt file. Why? An old hyperlinking lesson learnt some time back came flooding back to me. It was the address and file name, remove (or fill) the spaces in the address and the file name. Whallah.

Cheers
Ken

 

[KJH64]

Hi Jerry
Seeing as you have been soooo helpful and patient, can I push the friendship a little further with another problem.
Building on what I/we have done so far I now want to reverse this process (almost) and have each new invoice write certain data from within it back to a third spreadsheet which keeps a register of each of the new invoices if that makes sense. I have tried some basic methods of linking but they end up being just as labour intensive as doing it manually. Can this be automated via a VB script?

Thanks again.

Cheers
Ken

 

[jbeaucaire]

Well, in the macro already created you have lines of code that:

1) open a specific file by name
2) edit a specific cell on that sheet, and save it

Now you can add additional lines of code to:

1) open a different specific file by name
2) Add this invoice number to the bottom of the existing data

Take a shot at least #1 and possibly #2, see what you come up with, then we'll tweak it together.

I imagine the code would end up in the current macro right after this line:

Sheets("PERMITtoWORKpg1").Range("AA1") = "Incremented"

 

[KJH64]

Hi Jerry
Sadly I have not enough VB knowledge to get me much further than recognizing the line of code I need to open a specific file name.
This is as far as I got (blue line was added):

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If Sheets("PERMITtoWORKpg1").Range("AA1") = "" Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        Application.DisplayAlerts = False
        
        Workbooks.Open Filename:= _
            "\\caps7011\rtay2data$\PRE-OPS\Permit Office\Personnel\Ken Huntley\Permit_to_Work.xlt", Editable:=True
        With ActiveWorkbook.Sheets("PERMITtoWORKpg1")
            .Range("C2").Value = .Range("C2").Value + 1
        End With
        ActiveWorkbook.Close True
    
        Sheets("PERMITtoWORKpg1").Range("AA1") = "Incremented"
        "\\caps7011\rtay2data$\PRE-OPS\Permit Office\Personnel\Ken Huntley\Permit_Record.xls", Editable:=True
        Application.ScreenUpdating = True
        Application.EnableEvents = True
    End If

End Sub


Private Sub Workbook_BeforePrint(Cancel As Boolean)
    If Sheets("PERMITtoWORKpg1").Range("AA1") = "" Then
        MsgBox "You must save the workbook before printing is allowed."
        Cancel = True
    End If
End Sub

There are two workbooks in this new equation
1. Permit_to_Work.xls – of which there will be many
2. Permit_Record.xls – one only file containing tabulated data from each Permit_to_Work file

The variable cells in the Permit_to_Work are
C2 (which is the cell containing the unique number (invoice number)
C4
H4
N4
etc

This Data is to be recorded in Permit_Record.xls.

A2 - Permit_to_Work Filename
B2 - Permit_to_Work C2
C2 - Permit_to_Work C4
D2 - Permit_to_Work H4
etc
I follow that, as I do a save to the code will open up; firstly the xlt file and write to and save it; and then it needs to open the next file (Permit_Record) and write the values from each of the specified cells in the Pemit_to_Work(x).xls file to the applicable row in the Permit_Record file; and then on subsequent save to operations write to the next rows down.
The other tricky bit is the first column in Permit_Record I would like populated by the file name writing to it.

As i said i don't have the VB skills to work this last bit out.

Ken.

 

[jbeaucaire]

Maybe this:

        Sheets("PERMITtoWORKpg1").Range("AA1") = "Incremented"
        
        Workbooks.Open Filename:= _
            "\\caps7011\rtay2data$\PRE-OPS\Permit Office\Personnel\Ken Huntley\Permit_Record.xls", Editable:=True
        With ActiveWorkbook.Sheets(1)
            .[A2].Value = ThisWorkbook.Name  '?????
            .[B2].Value = ThisWorkbook.Sheets("PERMITtoWORKpg1").[C2].Value
            .[C2].Value = ThisWorkbook.Sheets("PERMITtoWORKpg1").[C4].Value
            .[D2].Value = ThisWorkbook.Sheets("PERMITtoWORKpg1").[H4].Value
            'etc...
        End With
                
        ActiveWorkbook.Save
        
        Application.ScreenUpdating = True
        Application.EnableEvents = True

If that section needs to increment down one row each time it is opened, then this:

        Sheets("PERMITtoWORKpg1").Range("AA1") = "Incremented"
        
        Dim NR As Long  'you can put this at the top with other DIMs
        
        Workbooks.Open Filename:= _
            "\\caps7011\rtay2data$\PRE-OPS\Permit Office\Personnel\Ken Huntley\Permit_Record.xls", Editable:=True
        With ActiveWorkbook.Sheets(1)
            NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1
            .Range("A" & NR).Value = ThisWorkbook.Name  '?????
            .Range("B" & NR).Value = ThisWorkbook.Sheets("PERMITtoWORKpg1").[C2].Value
            .Range("C" & NR).Value = ThisWorkbook.Sheets("PERMITtoWORKpg1").[C4].Value
            .Range("D" & NR).Value = ThisWorkbook.Sheets("PERMITtoWORKpg1").[H4].Value
            'etc...
        End With
                
        ActiveWorkbook.Save
        
        Application.ScreenUpdating = True
        Application.EnableEvents = True

 

[KJH64]

Jerry
Okay, after much tweaking and hair pulling, i haven't got any errors but the many documents are not writing to the one. This is what I have at the moment;

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    If Sheets("PERMITtoWORKpg1").Range("AA1") = "" Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        Application.DisplayAlerts = False
        
        Workbooks.Open Filename:= _
            "\\caps7011\rtay2data$\PRE-OPS\Permit Office\Personnel\Ken Huntley\Permit_to_Work.xlt", Editable:=True
        With ActiveWorkbook.Sheets("PERMITtoWORKpg1")
            .Range("C2").Value = .Range("C2").Value + 1
        End With
        ActiveWorkbook.Close True
    
        Sheets("PERMITtoWORKpg1").Range("AA1") = "Incremented"
        Dim NR As Long  'you can put this at the top with other DIMs
        Workbooks.Open Filename:= _
        "\\caps7011\rtay2data$\PRE-OPS\Permit Office\Personnel\Ken Huntley\Permit_Record.xls", Editable:=True
        With ActiveWorkbook.Sheets(1)
            NR = .Range("A" & .Rows.Count).End(xlUp).Row + 1
            .Range("A" & NR).Value = ThisWorkbook.Name  '?????
            .Range("B" & NR).Value = ThisWorkbook.Sheets("PERMITtoWORKpg1").[C2].Value
            .Range("C" & NR).Value = ThisWorkbook.Sheets("PERMITtoWORKpg1").[C4].Value
            .Range("D" & NR).Value = ThisWorkbook.Sheets("PERMITtoWORKpg1").[H4].Value
            'etc...
        End With
                
        ActiveWorkbook.Save

        Application.ScreenUpdating = True
        Application.EnableEvents = True
    End If

End Sub


Private Sub Workbook_BeforePrint(Cancel As Boolean)
    If Sheets("PERMITtoWORKpg1").Range("AA1") = "" Then
        MsgBox "You must save the workbook before printing is allowed."
        Cancel = True
    End If
End Sub

I'm guessing its the line in blue namely the '????. Not sure what to put there as the workbook name will be different each time as the workbook in question has an incremental file name ie. Permit_to_Work1.xls, Permit_to_Work2.xls, Permit_to_Work3.xls etc.
I suspect this feature may be too complex and may have to be omitted.

Ken

 

[jbeaucaire]

I"m just not able to follow it all anymore.

 

[KJH64]

Yes its getting rather complex. Thankyou anyway for you help to date.

Cheers
Ken