Increment a Template

[Stuart]

User opens a template (say MasterOrder.xlt). Code in the
ThisWorkbook module of the template increments the
value in "J9" of the template by one, from /1000/ to
/1001/ , the first time through.

So the user now has the workbook "MasterOrder1.xls"
open, sheet "Master Order" is displayed, and on it, cell
"J9" has the value "/1001/".

How do I increment the 'original' template so that next
time through, the new value would be "/1002/" ? because
since the user is only opening a copy of the template, then
the original still holds the value "/1000/".

I only wish to do this if the user chooses to save the file.
If they close without saving, then the original Order
number needs to be preserved.

Regards.

 

[Bob Phillips]

You could define a name in your Personal.xls, and use this value when the
template opens, saving Personal.xls when you exit.

Add this code to the template ThisWorkbook code module, and it will
automatically increment the Name UniqueId every time a new workbook is
created from the template.

You canm then Acess that name in your code by plugging this into the
existing code that strings that Id together

Evaluate(Workbooks("Personal.xls").Names("UniqueId").RefersTo)

Private Sub Workbook_Open()

GetId

End Sub

Private Sub GetId()
Dim myId As Long

myId = 1 ' in case it doesn't already exist
On Error Resume Next
myId = Evaluate(Workbooks("Personal.xls").Names("UniqueId").RefersTo) +
1
Workbooks("Personal.xls").Names.Add Name:="UniqueId", RefersTo:="=" &
myId


Dim VBCodeMod As Object
Dim iStart As Long
Dim cLines As Long

Set VBCodeMod =
ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
With VBCodeMod
iStart = .ProcStartLine("GetId", 0)
cLines = .ProcCountLines("MyNewProcedure", 0)
.DeleteLines iStart, cLines
End With


End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[Tom Ogilvy]

You would have to open the original template and increment the number.
Probably in the beforesave event.

 

[Stuart]

Many thanks to you both.
Let me give a little more information:

The file "MasterOrder.xlt" will be on a network drive. When a user
starts a new Project, they will open a copy of this file. Whilst open,
they will set up certain 'standard' fields ....ie items that will be common
to all orders in the new Project (such as Client name).
When done, they will save the file to the local drive and folder which
contains the new Project (say c:\New Project name\Orders).
The file would be saved with the name "E04123 MasterOrder.xlt",
where "E04123" is the unique Project/Job number. In the sheet, "H9"
is hardcoded as "E04/", "I9" is "123" entered by the user, and "J9" has
been set by code in the original template's ThisWorkbook module to
"/1000/".

So the user has set-up the Order template for their new Project.

When user requires a new order for that Job, they open the saved
template file. All the 'common' fields contain their previous data, and
code clears the contents of other user-permitted fields, ready for the
new Order information.

Can you help me with this sequence, please?

user opens their new Order template for the first time and:
i) the Order no. displays as E04/123/1001/
ii) If they quit without saving, then reset the template to /1000/
iii) The file (with their chosen name/folder) saves as *.xls)
iv) The saved file is stripped of all code

The 'original' template's ThisWorkbook code is as follows:

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
'may be needed
End Sub

Private Sub Workbook_Open()

With ActiveWorkbook.Worksheets("Master Order")
With Range("I9")
'check if user is setting up the template for a new Project
'if so, there will be no value in "I9"
If .Value <> "" Then
'Just another Order
Call ContractTemplate
Else
'It's a new Project
Call MasterTemplate
End If
End With
End With

End Sub

Private Sub ContractTemplate()

Dim i As Integer, C As Range

With ActiveWorkbook.Worksheets("Master Order")
.Unprotect Password:="SGB"
.Cells.Locked = False
With Range("J9")
.Value = "/" & CLng(Mid(.Value, 2, 4)) + 1 & "/"
End With
.Range("H11").Value = Format(Date, "dddd dd mmm yyyy")
For Each C In .Range("A1:N70")
If C.Interior.ColorIndex <> 34 Then
C.Locked = True
End If
Next
'Clear fields not common to all Orders in this Project
.Range("A2:E15").ClearContents
.Range("A31:K46").ClearContents
.Range("A50:K53").ClearContents
.Range("A57:K63").ClearContents
.Protect Password:="SGB"
.EnableSelection = xlUnlockedCells
End With
End Sub

Private Sub MasterTemplate()

Dim i As Integer, C As Range

With ActiveWorkbook.Worksheets("Master Order")
.Unprotect Password:="SGB"
.Cells.Locked = False
With Range("J9")
'Range "I9" is pre-set with the value "E04"
'what happens when it's 2005?
.Value = "/1000/"
End With
.Range("H11").Value = Format(Date, "dddd dd mmm yyyy")
For Each C In .Range("A1:N70")
If C.Interior.ColorIndex <> 34 Then
C.Locked = True
End If
Next
'make sure other areas are clear
.Range("A2:E15").ClearContents
.Range("A31:K46").ClearContents
.Range("A50:K53").ClearContents
.Range("A57:K63").ClearContents
.Protect Password:="SGB"
.EnableSelection = xlUnlockedCells
End With

MsgBox "Use this Order template to create the first Order" & vbNewLine & _
"for a new Contract." & vbNewLine & vbNewLine & _
"Enter all those items that will be 'standard' for every Order" & _
vbNewLine & "....eg Contract Name, Site Address, Site Agent etc." &
_
vbNewLine & vbNewLine & _
"When you are ready, save the workbook with its' new name" & _
vbNewLine & "eg: E04512 MasterOrder.xlt, and save it in the new" & _
vbNewLine & "Contract folder ....eg \New Contract\Orders." &
vbNewLine & _
vbNewLine & "When you next open the workbook from that folder," & _
vbNewLine & "it will automatically contain the current date, the" &
_
vbNewLine & "next Order number, and all the standard information." &
_
vbNewLine & vbNewLine & _
"Remember to save the file with '.xlt' as the file extension."

End Sub

Would be grateful for help, please.

Regards.