Is it possible to create a new workbook from within vba with some extra bits..

[SiEn]

Hello all, wonder if anyone can help. before i delve to deep into this i will try and explain what i am after..
I have a userform that returns results based on the form back onto a sheet at this point it also generates the next ID number.
From this i then have a workbook used as a base model that will then be copied into this reference ID and used. (This is my job book for each job I do)
just thinking of trying to save time here...

Is it possible when i enter those details and it generates that ID if its possible to copy and rename a workbook (so the base workbook) into the generated ID format.

If that is, is also then possible to create an automatic hyperlink to that workbook from the ID field within excel.?

I fully appreciate i may be asking a bit much here..

Any help gratefully received.

Simon

 

[SiEn]

Thanks for the reply, and apologies in my head its perfectly clear, but i think even reading it back i am struggling!

Right here goes...
Basically I have a Workbook which controls all of my individual quotes across all of the different types of work it can be (This is the workbook i attached)
From there i have another Workbook (with multiple tabs) that i build my quotes into. (This book is called Quotes Master Book)

Each time i raise a new quote in the book you have (Order Book) essentially the process that generates the Ref ID, I then copy and paste the Quotes Master Book and rename it to the generated Ref ID (i.e M-00001 etc) I then complete out that book. (That book it a real challenge for me to share as it contains so much information that I simply cannot share - if I have to then I will by hook or by crook!).

What I am attempting to achieve is some code I can add that when the Ref ID is generated in the Order Book it hyperlinks where the Ref ID goes in on the sheet and links to the Master Book which should also be copied as a new book and with the Ref ID as its name.

I hope that makes more sense.

Once again i really appreciate the help

Simon

 

[SiEn]

Did I manage to make this any clearer!? In my head its perfectly explained but I am sure I think that about most things

Simon

 

[OaklandJim]

I have been messin' around with the workbook. Making progress. I won't be able to do more until mid next week.

Here is some homework for you. Google these subjects to get familiar with Excel concepts that I need to or want to use for your workbook. These concepts are also powerful concepts to know about generally if you want to be a more proficient Excel designer/programmer.

If you are not familiar with these concepts my code will not be understandable or maintainable (by you). 1. Worksheet code names (Search), 2, Event handlers, especially worksheet change event (Search), 3. range names (Search) including names whose scope is worksheet-specific (Search), and 4. protection with "user interface only" (Search).

 

[OaklandJim]

I hope that THIS WORKBOOK does what is needed. I made a few modest changes to your code. I resisted the urge to rewrite subs.

Here is the code. You may have to change a couple of things like the name of the "template" file used for a new job file. My sub is called by one of the subs in the add new job form.

Private Sub cbAddRecord_Click()
        
    Worksheets(Me.cbType.Value).Select 'Selects the sheet to transfer data to
        
    UAS 'Unprotect All Sheets
    
    GenerateRefID 'finds the last number and adds one
    
    Range("B1").Select
    
    If ActiveCell.Offset(1, 0).Value = "" Then
        ActiveCell.Offset(1, 0).Select
    Else
        Selection.End(xlDown).Offset(1, 0).Select
    End If
    
    ActiveCell.Value = nextID
    'ActiveCell.Offset(0, 2).Value = Me.txtJobNumber.Value
    ActiveCell.Offset(0, 3).Value = Me.cbEstimator.Value
    ActiveCell.Offset(0, 4).Value = Me.cbType.Value
    ActiveCell.Offset(0, 5).Value = Me.txtJobTitle.Value
    ActiveCell.Offset(0, 6).Value = Me.cbJobStatus.Value
    ActiveCell.Offset(0, 11).Value = Now
    'ActiveCell.Offset(0, -1).Value = Range("A1").Value
    
    Dim N As String 'Prefix of RefID with format X-0000 and the next ID number
    Dim O As Integer 'Find the length of the Ref ID and Next ID number
    Dim P As String 'P re-arranges the length to fit the correct format (P and next ID completes this)
        
    N = Range("A1") & nextID
    O = Len(N)
    
    If O = 11 Then
        P = Left(Range("A1"), 2)
    ElseIf O = 10 Then
        P = Left(Range("A1"), 3)
    ElseIf O = 9 Then
        P = Left(Range("A1"), 4)
    ElseIf O = 8 Then
        P = Left(Range("A1"), 5)
    ElseIf O = 7 Then
        P = Left(Range("A1"), 6)
    End If
    
    ActiveCell.Offset(0, 1).Value = P & nextID
    
    Call MakeNewJobWorkbook(P & nextID, ActiveCell.Offset(0, 1))
    
    'ActiveCell.Offset(0, 12).Value = Range("A1") & nextID
    'ActiveCell.Offset(0, 13).Value = Len(ActiveCell.Offset(0, 12))
    'If ActiveCell.Offset(0, 13).Value = 11 Then
    'ActiveCell.Offset(0, 14).Value = Left(Range("A1"), 2)
    'ElseIf ActiveCell.Offset(0, 13).Value = 10 Then
    'ActiveCell.Offset(0, 14).Value = Left(Range("A1"), 3)
    'ElseIf ActiveCell.Offset(0, 13).Value = 9 Then
    'ActiveCell.Offset(0, 14).Value = Left(Range("A1"), 4)
    'ElseIf ActiveCell.Offset(0, 13).Value = 8 Then
    'ActiveCell.Offset(0, 14).Value = Left(Range("A1"), 5)
    'ElseIf ActiveCell.Offset(0, 13).Value = 7 Then
    'ActiveCell.Offset(0, 14).Value = Left(Range("A1"), 6)
    'End If
    
'   TURN PROTECTION BACK ON <=
    PAS 'Protect All Sheets
    
    Unload Me
                
End Sub

Option Explicit

' ----------------------------------------------------------------
' Procedure Name: MakeNewJobWorkbook
' Purpose: Creat new job workbook, add hyperlink to the file into cell whose content changed.
' Procedure Kind: Sub
' Procedure Access: Public
' Parameter psID (String): This is the job ID input by user.
' Parameter prChangedCell (Range): The cell whose value was changed.
' Author: Jim
' Date: 4/20/2023
' ----------------------------------------------------------------

Sub MakeNewJobWorkbook(psID As String, prChangedCell As Range)

'   ----------------------------
'          Declarations
'   ----------------------------
    
'   Worksheet in this workbook that user is changing.
    Dim wsTargetWorksheet As Worksheet

'   Path to the job files.
    Dim sJobWorkbookPath As String

'   The "base" name of the job workbook to save.
    Dim sJobWorkbookBaseName As String
    
'   The file name extension for the job workbook to save.
    Dim sJobWorkbookNameExt As String
    
'   Name of the the job workbook -- before ID is added -- to be created with extension.
    Dim sJobWorkbookName As String
    
'   Location of/path to the template file.
    Dim sTemplateWorkbookPath As String
    
'   File name -- with file name extension -- of the template workbook.
    Dim sTemplateWorkbookName As String
    
'   Variable used to message user.
    Dim sMsg As String
    
'   Used for user response to questions.
    Dim vAns As Variant
    
'   ----------------------------
'         Initializations
'   ----------------------------
    
'   Path to/folder containing the jobs workbooks.
    sJobWorkbookPath = ThisWorkbook.Path & "\"
    
'   "Base" file name for the job file that will be created.
    sJobWorkbookBaseName = "Job "

'   File name extension for the job file that will be created.
    sJobWorkbookNameExt = ".xlsx"

'   Full name of the Job file to create.
    sJobWorkbookName = sJobWorkbookBaseName & psID & sJobWorkbookNameExt
    
'   Path to/folder containing the template file.
    sTemplateWorkbookPath = ThisWorkbook.Path & "\"

'   Name of the template workbook.
    sTemplateWorkbookName = "QuoteBookTemplate.xlsx"
    
'   Worksheet in this workbook that is changing.
    Set wsTargetWorksheet = prChangedCell.Parent
    
'   -----------------------------------------
'         Handle Job File Already Exists
'   -----------------------------------------
    
'   Check if the job workbook to be saved already exists and whether user wants to replace it.
    If Dir(sJobWorkbookPath & sJobWorkbookName) <> "" _
     Then
        sMsg = "The file named " & sJobWorkbookName & " exists. Overwrite?"
        
        vAns = MsgBox(sMsg, vbYesNo)
        
'       If user said no to overwrite then bail out of sub.
        If vAns = vbNo Then Exit Sub
        
'       Delete the file before creating a new version.
        Kill (sJobWorkbookPath & sJobWorkbookName)
        
    End If

'   Open the template workbook. It becomes the ActiveWorkbook.
    Workbooks.Open sTemplateWorkbookPath & sTemplateWorkbookName
    
'   -----------------------------
'         Save New Job File
'   -----------------------------
    
'   Save copy of the template whose name is
    With ActiveWorkbook
        .SaveAs sJobWorkbookPath & sJobWorkbookName
        .Close
    End With
    
'   ----------------------------------------------------
'         Add Link That Opens the New Job Workbook
'   ----------------------------------------------------
   
'   With the worksheet into which the new ID was placed...
    With wsTargetWorksheet
            
'       Activate it
        .Activate
    
'       Then place hyperlink to the newly created job workbook file
'       into the cell into which the new ID was input.
        .Hyperlinks.Add Anchor:=prChangedCell, _
            Address:=sJobWorkbookPath & sJobWorkbookName, _
            TextToDisplay:=psID
            
         prChangedCell.Value = psID
    
    End With
    
End Sub

 

[SiEn]

Jim, thanks you so much, i will give this a whirl now and we look through the homework you have set
Ill get back to you, but thank you very much for your time it is very much appreciated.

Simon

 

[OaklandJim]

BTW, it turns out that I did not need code modules, events or sheet-scoped names. I tried to back fill into your workbook witht he least amount of new stuff.

Also, you'll need to change the line of code that specifies the name of the template file so it uses the name that you have assigned to that workbook.

'   Name of the template workbook.
    sTemplateWorkbookName = "QuoteBookTemplate.xlsx"

Also, there is one comment that is not complete.

This

'   -----------------------------
'         Save New Job File
'   -----------------------------
    
'   Save copy of the template whose name is
    With ActiveWorkbook
        .SaveAs sJobWorkbookPath & sJobWorkbookName
        .Close
    End With

Should be

'   -----------------------------
'         Save New Job File
'   -----------------------------
    
'   Save copy of the template whose name is specified in variable named sJobWorkbookName
'   and whose location is specified in variable named sJobWorkbookPath.
    With ActiveWorkbook
        .SaveAs sJobWorkbookPath & sJobWorkbookName
        .Close
    End With

 

[SiEn]

Thanks again Jim, i cant seem to get it to work.. I have changed the below am i doing this correct?

Path to/folder containing the jobs workbooks.
    sJobWorkbookPath = ThisWorkbook.Path & "\"
    
'   "Base" file name for the job file that will be created.
    sJobWorkbookBaseName = "Quote "

'   File name extension for the job file that will be created.
    sJobWorkbookNameExt = ".xlsm"

'   Full name of the Job file to create.
    sJobWorkbookName = sJobWorkbookBaseName & psID & sJobWorkbookNameExt
    
'   Path to/folder containing the template file.
    sTemplateWorkbookPath = ThisWorkbook.Path & "\"

'   Name of the template workbook.
    sTemplateWorkbookName = "QuoteSheetMaster.xlsm"
    
'   Worksheet in this workbook that is changing.
    Set wsTargetWorksheet = prChangedCell.Parent

 

[SiEn]

also does it make any difference that these files are all saved on sharepoint? I wonder if this is something i should of specified....

 

[OaklandJim]

I have not used Sharepoint so I cannot say whether that would cause grief. Try it locally on your computer first to see if it works. It definitely works correctly when I use the Add button in Type 1 worksheet.

 

[SiEn]

it works perfectly on local drive! now i need to work out how the sharepoint bit works then!

simply amazing bit of code that, I am interested that you used the phrase that you resisted the urge to re-write subs, any pointers on what i am doing etc..