CODEWITHSUNDEEP
vbaexcelexcel-2010
David Kris
David Kris

Reputation: 661

VBA Button creates new sheets to new workbook

In the code below, I have a button on a user form creating a new sheet from a template, renaming it and opening it in a new workbook as well as the current workbook. Is there anyway to have it automated so it doesn't create the new sheets in the current workbook and just the new workbook? Also it creates a new workbook every time, anyway to get all the new sheets created saved to one workbook when they are created? Anything helps, thanks!

Private Sub btnSave_Click()
Dim LastRow As Long, ws As Worksheet
Set ws = Sheets("Employee Information")
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1

If Me.cbStores.Value = "Northern / Northmart" Then
Dim newWB as Workbook
Dim thisWB as Workbook
Set thisWB = ThisWorkbook
set newWB = Application.Workbooks.Add

thisWB.Sheets("TEMPLATE").Copy after:=newWB.Sheets("Sheet1")
set sh = newWB.Sheets("TEMPLATE")
' Naming and hyperlink to new sheet
sh.Name = AddEmployeeUF.txtFirstname.Text + AddEmployeeUF.txtMiddleinitial.Text + AddEmployeeUF.txtLastname.Text + "Template"
ws.Hyperlinks.Add Anchor:=ws.Range("F" & LastRow), Address:="", SubAddress:=sh.Name & "!A1", TextToDisplay:="View"

EndIf
End Sub

Upvotes: 0

Views: 462

Answers (2)

David Zemens
David Zemens

Reputation: 53623

In an ordinary Code Module (not in the UserForm code module), do this outside of any procedure, at the top of the module:

Public newWB as Workbook

Then, your userform code like so (you'll need to modify with your additional code, since I don't have your worksheet structure & data available):

Private Sub btnSave_Click()
Dim sh As Worksheet

Dim thisWB As Workbook
Set thisWB = ThisWorkbook
If Module1.newWB Is Nothing Then
    Set Module1.newWB = Workbooks.Add
End If

thisWB.Sheets("TEMPLATE").Copy after:=newWB.Sheets(newWB.Sheets.Count)
Set sh = Module1.newWB.Sheets("TEMPLATE")
' Naming and hyperlink to new sheet
'sh.Name = AddEmployeeUF.txtFirstname.Text + AddEmployeeUF.txtMiddleinitial.Text + AddEmployeeUF.txtLastname.Text + "Template"

'This line raises an error because "ws" is not declared
'ws.Hyperlinks.Add Anchor:=ws.Range("F" & LastRow), Address:="", SubAddress:=sh.Name & "!A1", TextToDisplay:="View"

End Sub

The first time you run this code, Module1.newWB is nothing, it's not been assigned any object value. So, a new workbook is created using the Workbooks.Add method, assigned to the Module1.newWB variable, and this variable persists until you close the file or if there is a state loss in the VBA runtime (i.e., an unhandled exception which you abort or terminate runtime, etc.).

Upvotes: 0

user3598756
user3598756

Reputation: 29421

you could tweak your code as follows:

    Set newWB = GetOrCreateWB("NewWb", "C:\Users\....\MyFolder") '<--| try getting the already open "NewWb" workbook or opening it from given folder ore create it in given folder

    thisWB.Sheets("TEMPLATE").Copy after:=newWB.Sheets(1)
    With ActiveSheet '<--| the just pasted worksheet becomes the active one
        .Name = AddEmployeeUF.txtFirstname.Text + AddEmployeeUF.txtMiddleinitial.Text + AddEmployeeUF.txtLastname.Text + "Template" '<--| Name it
        ws.Hyperlinks.Add Anchor:=ws.Range("F" & LastRow), Address:="", SubAddress:=.Name & "!A1", TextToDisplay:="View" '<--| hyperlink to new sheet
    End With

 Next i

which exploites the following funtion:

Function GetOrCreateWB(wbName As String, wbPath As String) As Workbook
    On Error Resume Next
    Set GetOrCreateWB = Workbooks(wbName)
    If GetOrCreateWB Is Nothing Then
        Set GetOrCreateWB = Workbooks.Open(wbPath & "\" & wbName)
        If GetOrCreateWB Is Nothing Then
            Set GetOrCreateWB = Workbooks.Add
            GetOrCreateWB.SaveAs Filename:=wbPath & "\" & wbName
        End If
    End If
End Function

Upvotes: 1

Related Questions