PDA

View Full Version : [SOLVED] Need to create a separate worksheet for each row of data



gameplayer85
09-04-2016, 07:38 AM
Hello
I am using Windows 10 with Office 2013. I have an Excel problem which I believe requires the use of Visual Basic. I have attached the sheet below. I have a list of data on the Claim data tab and an example template on the Template tab. What I need to do is create a template for each row of data in the Claim data tab and then pop in the data for each row in each template. The number of rows will fluctuate. I imagine we could use a macro button to create the templates and fill in each row of data. I added a row counter in cell H5 on the Claim data tab.

Thanks in advance for any help

Paul_Hossler
09-04-2016, 01:35 PM
Something like this maybe. Attachment has the macro and the results



Option Explicit

Sub GenerateClaims()

Dim wsTemplate As Worksheet
Dim wsClaims As Worksheet
Dim wsClaim As Worksheet
Dim rClaims As Range, rClaim As Range
Dim sClaimSheet As String

Application.ScreenUpdating = False

Set wsTemplate = Worksheets("Template")
Set wsClaims = Worksheets("Claim Data")

Set rClaims = wsClaims.Range("B4").CurrentRegion
Set rClaims = rClaims.Cells(2, 1).Resize(rClaims.Rows.Count - 1, rClaims.Columns.Count)

For Each rClaim In rClaims.Rows
With rClaim
sClaimSheet = wsClaims.Name & "-" & Format(.Cells(1).Value, "000")

'delete sheet if it exists
On Error Resume Next
Application.DisplayAlerts = False
Worksheets(sClaimSheet).Delete
Application.DisplayAlerts = True
On Error GoTo 0

'copy empty template
wsTemplate.Copy before:=wsTemplate
Set wsClaim = ActiveSheet
wsClaim.Name = sClaimSheet

'do all work on the copy
wsClaim.Range("D6") = .Cells(2).Value
wsClaim.Range("D7") = .Cells(3).Value
wsClaim.Range("D8") = .Cells(4).Value
wsClaim.Range("D9") = .Cells(5).Value

End With
Next
Application.ScreenUpdating = True

End Sub

snb
09-04-2016, 01:49 PM
Avoid merged cells.

This code suffices:


Sub M_snb()
sn = Sheet2.ListObjects(1).DataBodyRange

For j = 1 To UBound(sn)
Sheets("template").Copy , Sheets(Sheets.Count)
Sheets(Sheets.Count).Range("B2:B5") = Application.Transpose(Application.Index(sn, j, Array(2, 3, 4, 5)))
Next
End Sub

gameplayer85
09-04-2016, 01:59 PM
Thank you snb, this works well. I added the macro button and when I click on it, it creates each of the template sheets. The only issue is that it is putting the data in the range d6:d9 instead of b2:b5. How do I fix it? I can see that you've used b2:b5 but it isn't going there

Thanks again

gameplayer85
09-04-2016, 02:03 PM
Also, is it possible to add a second macro that will delete all of the created template sheets once we have finished the work?

gameplayer85
09-04-2016, 02:11 PM
Thank you Paul, this works well. What I would like ideally is a spreadsheet with just the first two tabs (template and claim data) when the user enters it. They would click on the macro button and it would then create all of the populated templates. Is this possible? I know enough to add the macro button and tie it to the code but I'm not a programmer

Thanks again

gameplayer85
09-04-2016, 02:13 PM
Strange, I closed and then reopened your sheet and now its posting in the right place.

Paul_Hossler
09-04-2016, 05:51 PM
Added a call to DeleteClaims in the WB open event so any existing claim sheets will be deleted

Also added 2 macro buttons to the Claims worksheet






Sub DeleteClaims()
Dim ws As Worksheet

Application.ScreenUpdating = False

For Each ws In ThisWorkbook.Worksheets
If UCase(ws.Name) <> "TEMPLATE" And UCase(ws.Name) <> "CLAIM DATA" Then
On Error Resume Next
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
On Error GoTo 0
End If
Next
Application.ScreenUpdating = True
End Sub

gameplayer85
09-04-2016, 06:02 PM
Paul,
Wow that is outstanding! Thanks for all of your help. I am marking this as solved. Isnt there a way to giver you kudos for this? Most sites allow me to add to your reputation or something like it
Thanks again!

gameplayer85
09-04-2016, 06:04 PM
Paul, I just figured out how to upvote the thread. Thanks again

snb
09-04-2016, 10:45 PM
Thank you snb, this works well. I added the macro button and when I click on it, it creates each of the template sheets. The only issue is that it is putting the data in the range d6:d9 instead of b2:b5. How do I fix it? I can see that you've used b2:b5 but it isn't going there

Thanks again

You didn't use the 'template' in the file I send.

To delete the new sheets:


Sub M_snb()
For Each sh In Sheets
c00 = c00 & "|" & sh.Name
Next

Application.DisplayAlerts = False
Sheets(Filter(Split(c00, "|"), "Template (")).Delete
End Sub

jolivanes
09-06-2016, 10:44 PM
Re: To delete the new sheets:



Sub M_snb()
For Each sh In Sheets
c00 = c00 & "|" & sh.Name
Next

Application.DisplayAlerts = False
Sheets(Filter(Split(c00, "|"), "Template (")).Delete

End Sub


I assume that this

Sheets(Filter(Split(c00, "|"), "Template (")).Delete
should be

Sheets(Filter(Split(c00, "|"), "Template")).Delete
But that deletes the Template sheet and leaves the rest in peace

snb
09-06-2016, 11:20 PM
@Joli

Every copy of the sheet 'Template' get automatically the name "Template (1)", "Template (2)"

That why I can filter these using
Sheets(Filter(Split(c00, "|"), "Template (")).Delete

Excluding the Template sheet, its name not containing a space & a (

jolivanes
09-07-2016, 12:06 AM
OK, thank you very much for the explanation.
It's (past) bedtime here so I'll have to get at it in the morning.
Thanks again

jolivanes
09-07-2016, 03:54 PM
@snb

After inserting this

Sheets(Sheets.Count).Name = sn(j, 1)
in the code
this
"the name "Template (1)", "Template (2)""
is not valid anymore!!!!!!


Appreciate your time and explanation.