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
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