Automatically Refresh, Add new sheet using template if needed

Excel cior

New Member
Joined
Jan 22, 2014
Messages
1
Please bear with me as I am pretty new with Excel VBA. I have a code that I found on the internet that I have somewhat modified to fit my purpose.

What I am trying to do is this:
I have a master sheet, and a template sheet. The macro grabs information from the master sheet, then takes the template, copies and fills it out, making a new worksheet for each name in "H" on the master sheet.

My problem is that I need the macro to refresh either automatically when opened or by an added in button. When it refreshes, I would like for it to refresh any changed information on the master sheet as well as check "H" on the master sheet for new entries and then if there is a new entry, have it create a new sheet, otherwise do nothing.

I currently have 150 cells under "H" on the master sheet. When I run it the first time, it does exactly what I would like for it to do and creates the 150 worksheets. But say I add another entry to make it 151 or change up some existing information. It does not refresh, and when I run the macro a second time, it just creates another 151 worksheets on top of the 150 already there, making a total of 301 worksheets which is not what I need.

This is the code currently:

Sub FillOutTemplates()


Dim LastRw As Long, Rw As Long, Cnt As Long
Dim dSht As Worksheet, tSht As Worksheet
Dim MakeBooks As Boolean, SavePath As String


Application.ScreenUpdating = False 'speed up macro execution
Application.DisplayAlerts = False 'no alerts, default answers used


Set dSht = Sheets("Data") 'sheet with data on it starting in row2
Set tSht = Sheets("Template") 'sheet to copy and fill out


'Option to create separate workbooks
MakeBooks = MsgBox("Create separate workbooks?" & vbLf & vbLf & _
"YES = template will be copied to separate workbooks." & vbLf & _
"NO = template will be copied to sheets within this same workbook", _
vbYesNo + vbQuestion) = vbYes


If MakeBooks Then 'select a folder for the new workbooks
MsgBox "Please select a destination for the new workbooks"
Do
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then 'a folder was chosen
SavePath = .SelectedItems(1) & "\"
Exit Do
Else 'a folder was not chosen
If MsgBox("Do you wish to abort?", _
vbYesNo + vbQuestion) = vbYes Then Exit Sub
End If
End With
Loop
End If


'Determine last row of data then loop through the rows one at a time
LastRw = dSht.Range("A" & Rows.Count).End(xlUp).Row

For Rw = 2 To LastRw
tSht.Copy After:=Worksheets(Worksheets.Count) 'copy the template
With ActiveSheet 'fill out the form
'edit these rows to fill out your form, add more as needed
.Name = dSht.Range("H" & Rw)
.Range("A8").Value = "=Data!A" & Rw 'dSht.Range("A" & Rw).Value
.Range("F8").Value = "=Data!C" & Rw
.Range("F9").Value = "=Data!G" & Rw
.Range("F11").Value = "=Data!D" & Rw
.Range("F12").Value = "=Data!E" & Rw
End With

If MakeBooks Then 'if making separate workbooks from filled out form
ActiveSheet.Move
ActiveWorkbook.SaveAs SavePath & Range("A8").Value, xlNormal
ActiveWorkbook.Close False
End If
Cnt = Cnt + 1
Next Rw


dSht.Activate
If MakeBooks Then
MsgBox "Workbooks created: " & Cnt
Else
MsgBox "Worksheets created: " & Cnt
End If

Application.ScreenUpdating = True
End Sub
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.

Forum statistics

Threads
1,223,248
Messages
6,171,021
Members
452,374
Latest member
keccles

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top