Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

How do I get VBA to Create a multiple worksheets using a template from data

Posted on 2015-02-02
11
Medium Priority
?
248 Views
Last Modified: 2016-09-13
Hi experts

I have a VBA script that creates multiple worksheets from a masterdata sheet. (File attached/code below).  I would like the data to be created on a templated worksheet rather than a plain one.

Can this be done?

In my example the MasterData worksheet has all my reporting, the macro reads column A and creates a new sheet for each name change.  You can run the code to see an example.

Also included in the workbook is 'Example with tempate' this is how I want each created sheet to look with the relevant data. Rows 1-10 contain data I'd like on each report.  I would also like the managers name to appear in Cell C5 rather than as the first column.

Can you help?
Thank you


Code
Sub CreateSheets()
Dim ws As Worksheet, sh As Worksheet, rng As Range, cel As Range
    
Application.ScreenUpdating = False
    
Set ws = Worksheets("MasterData")
    
With ws.UsedRange.Columns("A")
    .AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    Set rng = .SpecialCells(xlVisible)
End With
    
ws.ShowAllData
    
For Each cel In rng.Cells
    If Trim(cel.Value) <> "" And cel.Row <> rng.Cells(1).Row Then
        ws.Copy After:=Worksheets(Worksheets.Count)
        Set sh = ActiveSheet
        sh.UsedRange.AutoFilter Field:=sh.Columns("A").Column, Criteria1:="<>" & cel, Operator:=xlAnd
        sh.UsedRange.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        sh.UsedRange.AutoFilter
        sh.Name = cel
        Application.Goto sh.[A1]
    End If
Next cel
    
Application.ScreenUpdating = True
    

End Sub

Open in new window

ExcelExample.xlsm
0
Comment
Question by:wisemat
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 5
11 Comments
 
LVL 31

Expert Comment

by:gowflow
ID: 40584352
Yes for sure this can be done.

Question:
Will you be creating all these sheets always in the same workbook onto new sheets or you need to have them into a new workbook ?

Also in your template Cell B7 what is this: Blurb goes here ??? it is not in MasterData where do we get it from ??
gowlfow
0
 

Author Comment

by:wisemat
ID: 40584378
Oh that's great news!
All in the same workbook so it's self contained
0
 
LVL 31

Expert Comment

by:gowflow
ID: 40584504
ok here it is.

Sub CreateSheets()
Dim WS As Worksheet, sh As Worksheet, WST As Worksheet
Dim rng As Range, cel As Range
Dim Rmgr As Range, RItem As Range
Dim lRow As Long, MaxRow As Long, I As Long
Dim sMgr As String

Application.ScreenUpdating = False
    
'---> Set Variables
Set WS = Worksheets("MasterData")
MaxRow = WS.Range("A" & WS.Rows.Count).End(xlUp).Row

Set WST = Worksheets("Template")


'---> Sort Master Data by Manager Name
WS.UsedRange.Sort Key1:=WS.Range("A1"), order1:=xlAscending, Header:=xlNo, MatchCase:=False


For I = 1 To MaxRow
    If WS.Cells(I, "A") <> sMgr Then
        WST.Copy After:=Worksheets(Worksheets.Count)
        Set sh = Sheets(Worksheets.Count - 1)
        sh.Visible = xlSheetVisible
        sh.Name = WS.Cells(I, "A")
        sMgr = WS.Cells(I, "A")
        
        '---> Mgr Name
        sh.Cells(5, "C") = sMgr
        lRow = 11
    End If
        
    '---> Get the details
    WS.Range("A" & I & ":G" & I).Copy
    sh.Range("B" & lRow).PasteSpecial (xlPasteValues)
    sh.Range("B" & lRow & ":L" & lRow).Interior.ColorIndex = 0
    lRow = lRow + 1


Next I


Application.ScreenUpdating = True
    
MsgBox "Sheets created successfully.", vbInformation
End Sub

Open in new window


Simply open the attached workbook, enable macros, then from the developer menu choose Macroes and run CreateSheets and check the results.

Let me know if anything need modification.

NOTE
Still, you did not answer my question about Cell B7 : 'Blurb goes here'

gowflow
ExcelExample-V01.xlsm
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:wisemat
ID: 40584615
Hey that's awesome, Just checking it out now, sorry for the delay i was on the underground
0
 

Author Comment

by:wisemat
ID: 40584658
That's almost spot on my friend.

The blurb bit will just be where i can put some template information to the manager, like indicate with a 'x' in the cell to keep or remove the user.

Coud it be so on the generated reports the BossMan columis not there?
So there is the template, the bossman name filled in in C5 and then the data (sans bossman name/row).

Not a deal breaker if you cant.

Thanks
0
 
LVL 31

Expert Comment

by:gowflow
ID: 40584766
Sorry do not understand you request.

can you re-phrase in English ?
gowflow
0
 

Author Comment

by:wisemat
ID: 40584790
In English, I have updated the template
I have removed the 'manager name' column from the reuqired templated result.  I did this because the manager name is in cell C5, it seemed silly to have it repeating over and over in a column down the page.

So i was asking if macro could accomodate that change.  I would be grateful.
ExcelExample-V02.xlsm
0
 
LVL 31

Accepted Solution

by:
gowflow earned 2000 total points
ID: 40585650
Here it is with some 'makeup' on final behavior.

Sub CreateSheets()
Dim WS As Worksheet, sh As Worksheet, WST As Worksheet
Dim rng As Range, cel As Range
Dim Rmgr As Range, RItem As Range
Dim lRow As Long, MaxRow As Long, I As Long
Dim sMgr As String

Application.ScreenUpdating = False
    
'---> Set Variables
Set WS = Worksheets("MasterData")
MaxRow = WS.Range("A" & WS.Rows.Count).End(xlUp).Row

Set WST = Worksheets("Template")


'---> Sort Master Data by Manager Name
WS.UsedRange.Sort Key1:=WS.Range("A1"), order1:=xlAscending, Header:=xlNo, MatchCase:=False


For I = 1 To MaxRow
    If WS.Cells(I, "A") <> sMgr Then
        If Not sh Is Nothing Then
            sh.Activate
            sh.Cells(1, 1).Select
        End If
        WST.Copy After:=Worksheets(Worksheets.Count)
        Set sh = Sheets(Worksheets.Count - 1)
        sh.Visible = xlSheetVisible
        sh.Name = WS.Cells(I, "A")
        sMgr = WS.Cells(I, "A")
        
        '---> Mgr Name
        sh.Cells(5, "C") = sMgr
        lRow = 11
    End If
        
    '---> Get the details
    WS.Range("B" & I & ":G" & I).Copy
    sh.Range("B" & lRow).PasteSpecial (xlPasteValues)
    sh.Range("B" & lRow & ":L" & lRow).Interior.ColorIndex = 0
    lRow = lRow + 1


Next I

If Not sh Is Nothing Then
    sh.Activate
    sh.Cells(1, 1).Select
End If
        
WS.Application.CutCopyMode = xlNone
WS.Activate
WS.Cells(1, 1).Select

Application.ScreenUpdating = True
    
MsgBox "Sheets created successfully.", vbInformation
End Sub

Open in new window


Pls check it and let me know.
gowflow
ExcelExample-V02.xlsm
0
 

Author Closing Comment

by:wisemat
ID: 40585769
Thank you gowflow,

The perfect solution, simple to use and 100% of requirements.

Full marks!!!
0
 
LVL 31

Expert Comment

by:gowflow
ID: 40585773
Thank you and glad I could help.
gowflow
0
 

Expert Comment

by:Cheese Club
ID: 41797263
Hi There,

I am wondering - what if the template is from a separate workbook, after running the Macro on MasterData, it generates multiple workbooks with the same template outside the Master Data and they all store under the same folder. What will be changed from the code?

Thank you.
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
We live in a world of interfaces like the one in the title picture. VBA also allows to use interfaces which offers a lot of possibilities. This article describes how to use interfaces in VBA and how to work around their bugs.
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

661 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question