VBA Macro lost after saving and closing as xslm

Question

my situation: I have an Excel Workbook that is supposed to create a new Workbook with xslm as file extension, edit the names of the single sheets and put some data in it.

After that a ComboBox is created and the ComboBox is filled with data and in the new Workbook a macro is created that has a ComboBox1_Change Sub.

When all this is done the new Workbook is saved and closed.

Now the problem is, if I reopen the Workbook the ComboBox is empty and the Macro is not anymore in the Workbook. After some research I only found this problem with people saving a sheet as xlsx instead of xslm, but I made sure that this is not the case with my code.

Maybe I am overlooking something, but I even made a breakpoint on the close command to check if everything worked and it does what it should do until then. So the problem must be within the close and save. I even tried to save it and close it separately or to set the new Workbook active and save it. Maybe someone here can help me.

EDIT: I am using Excel 2007

Thanks in advance the code is below:

The Sub to create the new Workbook:

Sub createTemplate()
Dim currentWB As Workbook
Set currentWB = ThisWorkbook
Dim template As Workbook
Dim curResSht As Worksheet
Dim temUtiSht As Worksheet
Dim curHolSht As Worksheet
Dim temHolSht As Worksheet
Workbooks.Add
Set curResSht = currentWB.Worksheets("Resource Plan")
Set curHolSht = currentWB.Worksheets("Holidays")
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=currentWB.Path & "\Template.xlsm", FileFormat:=52
Set template = ActiveWorkbook
template.Sheets(3).name = "Holidays"
template.Sheets(2).name = "Person List"
template.Sheets(2).Visible = False
template.Sheets(1).name = "Utilisation"
Set temUtiSht = template.Worksheets("Utilisation")
Set temHolSht = template.Worksheets("Holidays")
For i = 1 To 4
    curResSht.Rows(i).EntireRow.Copy
    temUtiSht.Rows(i).EntireRow.PasteSpecial
Next i

For i = 1 To 3
    curHolSht.Rows(i).EntireRow.Copy
    temHolSht.Rows(i).EntireRow.PasteSpecial
Next i

Application.DisplayAlerts = True

Dim curDatSht As Worksheet
Dim temLisSht As Worksheet
Set curDatSht = currentWB.Worksheets("Data")
Set temLisSht = template.Worksheets("Person List")
i = 5
Dim j As Integer
j = 1
While Not IsEmpty(curResSht.Cells(i, 1))
    If curResSht.Cells(i, 1).Interior.Color = curDatSht.Cells(2, 1).Interior.Color Then GoTo skipLine
    If curResSht.Cells(i, 3).Value = "Total" Then GoTo skipLine
    For k = 1 To 7
        curResSht.Cells(i, k).Copy
        temLisSht.Cells(j, k).PasteSpecial
    Next k
    j = j + 1
skipLine:
    i = i + 1
Wend

Set temCom = temUtiSht.OLEObjects.Add(ClassType:="Forms.ComboBox.1", Link:=False, DisplayAsIcon:=False, Left:=49, Top:=30, Width:=200, Height:=25)
template.Save
template.Close
Workbooks.Open (currentWB.Path & "\Template.xlsm")
Call fillEmpInLis
Call createCodeInTemplate
Application.Workbooks("Template.xlsm").Close savechanges:=True
End Sub

The Macro creating Sub:

Sub createCodeInTemplate()
Dim tmWB As Workbook
Dim tmVP As VBProject
Dim tmVC As VBComponent
Dim tmCM As CodeModule

Set tmWB = Application.Workbooks("Template.xlsm")
Set tmVP = tmWB.VBProject
Set tmVC = tmVP.VBComponents("Sheet1")
Set tmCM = tmVC.CodeModule

With tmCM
    .InsertLines 1, "Private Sub ComboBox1_Change()"
    .InsertLines 2, vbTab & "Dim sht As Worksheet"
    .InsertLines 3, vbTab & "Dim sht2 As Worksheet"
    .InsertLines 4, vbTab & "Dim sht3 As Worksheet"
    .InsertLines 5, vbTab & "Set sht = ThisWorkbook.Worksheets(""Utilisation"")"
    .InsertLines 6, vbTab & "Set sht2 = ThisWorkbook.Worksheets(""Person List"")"
    .InsertLines 7, vbTab & "Set sht3 = ThisWorkbook.Worksheets(""Holidays"")"
    .InsertLines 8, vbTab & "Dim k As Integer"
    .InsertLines 9, vbTab & "k = 4"
    .InsertLines 10, vbTab & "Dim i As Integer"
    .InsertLines 11, vbTab & "i = 5"
    .InsertLines 12, vbTab & "Dim j As Integer"
    .InsertLines 13, vbTab & "j = 1"
    .InsertLines 14, vbTab & "While Not IsEmpty(sht.Cells(i, 1))"
    .InsertLines 15, vbTab & vbTab & "i = i + 1"
    .InsertLines 16, vbTab & "Wend"
    .InsertLines 17, vbTab & "While Not IsEmpty(sht3.Cells(k, 1))"
    .InsertLines 18, vbTab & vbTab & "k = k + 1"
    .InsertLines 19, vbTab & "Wend"
    .InsertLines 20, vbTab & "While Not IsEmpty(sht2.Cells(j, 1))"
    .InsertLines 21, vbTab & vbTab & "If sht2.Cells(j, 1).Value = ComboBox1.Value Then"
    .InsertLines 22, vbTab & vbTab & vbTab & "sht2.Rows(j).EntireRow.Copy"
    .InsertLines 23, vbTab & vbTab & vbTab & "sht.Rows(i).EntireRow.PasteSpecial"
    .InsertLines 24, vbTab & vbTab & vbTab & "sht2.Cells(i, 1).Copy"
    .InsertLines 25, vbTab & vbTab & vbTab & "sht3.Cells(k, 2).PasteSpecial"
    .InsertLines 26, vbTab & vbTab & vbTab & "sht2.Cells(i, 2).Copy"
    .InsertLines 27, vbTab & vbTab & vbTab & "sht3.Cells(k, 1).PasteSpecial"
    .InsertLines 28, vbTab & vbTab & vbTab & "k = k + 1"
    .InsertLines 29, vbTab & vbTab & vbTab & "i = i + 1"
    .InsertLines 30, vbTab & vbTab & "End If"
    .InsertLines 31, vbTab & vbTab & "j = j + 1"
    .InsertLines 32, vbTab & "Wend"
    .InsertLines 33, "End Sub"
End With
End Sub

And the Sub to fill the ComboBox:

Sub fillEmpInLis()
Dim wb As Workbook
Dim utiSht As Worksheet
Dim perSht As Worksheet
Set wb = Application.Workbooks("Template.xlsm")
Set utiSht = wb.Worksheets("Utilisation")
Set perSht = wb.Worksheets("Person List")
Set box = wb.Sheets("Utilisation").ComboBox1
box.Clear
Dim i As Integer
i = 2

box.AddItem perSht.Cells(1, 1).Value
While Not IsEmpty(perSht.Cells(i, 1))
    Dim resultIndex As Boolean
    resultIndex = False
    For j = 0 To box.ListCount - 1
        If box.List(j) = perSht.Cells(i, 1).Value Then
            resultIndex = True
        End If
    Next j
    If resultIndex = False Then
        For j = 0 To box.ListCount - 1
            If perSht.Cells(i, 1) < box.List(j) And j = 0 Then
                box.AddItem perSht.Cells(i, 1), j
                GoTo skip
            ElseIf perSht.Cells(i, 1) > box.List(j) And j = box.ListCount - 1 Then
                box.AddItem perSht.Cells(i, 1)
                GoTo skip
            ElseIf perSht.Cells(i, 1) > box.List(j) And perSht.Cells(i, 1) < box.List(j + 1) Then
                box.AddItem perSht.Cells(i, 1), j
                GoTo skip
            End If
        Next j
skip:
    End If
    i = i + 1
Wend
End Sub

Wouldn't it be easier to manually create a template workbook containing the code & controls then use that in your code? Your code would also fail if the user has set their Excel options to create new workbooks with a single sheet - there wouldn't be sheets to rename 'Holidays' and 'Person Lists'. — Darren Bartrup-Cook
I added the Excel version (2007) that I am using. @DarrenBartrup-Cook yes that may be easier, but I am doing it this way as the template will have to change if there are changes in the main workbook and it is faster and easier for the user to press a button to create the new version of the template, instead of creating a new version manually every time — Bumpf
If you've done "Save As" then why do you need to copy/paste information and macro code over? It should all be there anyway? — SierraOscar

Fabian F Fabian F · Accepted Answer · 2016-09-29T13:24:02

I hope this will help:

My guess is that the macro code is not correctly created in the template when saved. So I just copied your code to an empty workbook and made these changes in the Sub that creates your macro-code:

Sub createCodeInTemplate()
  Dim tmWB As Workbook

    Set tmWB = Application.Workbooks("Template.xlsm")

    With tmWB.VBProject.VBComponents(tmWB.Sheets("Utilisation").CodeName).CodeModule

I then tested the complete code and the file that was created (Template.xlsm) was containing the macro-code.

As I am using Excel 2013 it might not help you but I'd give it a try.

VBA Macro lost after saving and closing as xslm

1 Answers