In need a VBA script to create sheets from 3 different template sheets and more...

[vlacombe]

Hello all, first time here! I'm not proeficient much with VBA, hopefully someone can help me.

I need a VBA script to create a dynamic amount of sheets at once based on 12 different cells value, from 3 different template sheets (I need to keep those 3 templates formula intact) and based on some cells from my "Master" sheet

So basically I have these 4 sheets:

Temp1
Temp2
Temp3
Master

On my "Master" sheet I have column Type1 (C12 to C15), Type2 (D12 to D15) and Type3 (E12 to E15)
These cells are either empty or a numerical value ranging from 100 to 500 or so

I want the script to create sheets only if C12 to E15 have a value in them...
If C13 has a value of 150 and D12 has one of 300, the sheet name created by the script must be Type1-150 and Type2-300 (As C13 has a value of 150 and belong to column Type1 and D12 has a value of 300 and belong to the column Type2)

Type1 created sheets must use the Temp1 template and so long for 2 and 3...
Along with the template copied as is with its respective formula. My master sheets contains additionnal information that needs to be copied on all the created sheets

Here's the details:

From "Master" to any created sheets
C3 to C8 and H3 to H8 needs to go to C9 to C14 and H9 to H14
J11 needs to go to B23
J12 needs to go to B29
J13 needs to go to B30
J14 needs to go to B32
J15 needs to go to I28

It seems overwhelming to me but perhaps some good soul is willing to assist
Thank you very much!

 

[vlacombe]

Bump!

 

[Peter_SSs]

Welcome to the MrExcel board!

.. the sheet name created by the script must be Type1-150 and Type2-300

I have assumed that such sheet names will not already exist otherwise this code could error out.
If it is possible that a sheet name could already exist, please advise what should happen when the code gets to creating another one with the same name.

Test this in a copy of your workbook.

Sub Create_Sheets()
  Dim wsM As Worksheet
  Dim rngTemplateNumbers As Range
  Dim r As Long, c As Long
  Dim sName As String
  
  Set wsM = Sheets("Master")
  Application.ScreenUpdating = False
  With wsM
    Set rngTemplateNumbers = .Range("C12:E15")
    With rngTemplateNumbers
      For c = 1 To .Columns.Count
        For r = 1 To .Rows.Count
          If Len(.Cells(r, c).Value) > 0 Then
            sName = "Type" & c & "-" & .Cells(r, c).Value
            Sheets("Temp" & c).Copy After:=Sheets(Sheets.Count)
            With Sheets(Sheets.Count)
              .Name = sName
              wsM.Range("C3:C8").Copy Destination:=.Range("C9")
              wsM.Range("H3:H8").Copy Destination:=.Range("H9")
              wsM.Range("J11").Copy Destination:=.Range("B23")
              wsM.Range("J12:J13").Copy Destination:=.Range("B9")
              wsM.Range("J14").Copy Destination:=.Range("B32")
              wsM.Range("J15").Copy Destination:=.Range("I28")
            End With
          End If
        Next r
      Next c
    End With
  End With
  Application.ScreenUpdating = True
End Sub

 

[vlacombe]

Thank you very much Peter, I will test it right away when I get back to it on Monday or Tuesday.

And yes, given that the sheet(s) exist, which could happen, the script should ignore the already created sheet(s) and not overwrite data on them, but it should also check for non created ones and create them

Back to my above example (If C13 has a value of 150 and D12 has one of 300, the sheet name created by the script must be Type1-150 and Type2-300)
The script, when used, should create Type1-150 and Type2-300

If I go back to my master sheet and enter a value of 250 in cell C12 and 400 in cell E15 while C13 and D12 remains intact:
Script should ignore C13 and D12 as both sheets are existent and create Type1-250 and Type3-400

Extensively, if it's not too complicated, if I have more than 1 cell cells with the same value under the same column (Type), for instance C12, C13, C14 and C15 are all 200:
Sheets created should be Type1-200, Type1-200-2, Type1-200-3, Type1-200-4

4 of them with the same type and number would be the highest amount of possible created copies

Thank you again for your time

 

[Peter_SSs]

See how this goes

Sub Create_Sheets_v2()
  Dim d As Object
  Dim wsM As Worksheet, ws As Worksheet
  Dim rngTemplateNumbers As Range
  Dim r As Long, c As Long
  Dim sName As String
  
  Set d = CreateObject("Scripting.Dictionary")
  Set wsM = Sheets("Master")
  Application.ScreenUpdating = False
  With wsM
    Set rngTemplateNumbers = .Range("C12:E15")
    With rngTemplateNumbers
      For c = 1 To .Columns.Count
        For r = 1 To .Rows.Count
          If Len(.Cells(r, c).Value) > 0 Then
            sName = "Type" & c & "-" & .Cells(r, c).Value
            d(sName) = d(sName) + 1
            If d(sName) > 1 Then sName = sName & -d(sName)
            Set ws = Nothing
            On Error Resume Next
            Set ws = Sheets(sName)
            On Error GoTo 0
            If ws Is Nothing Then
              Sheets("Temp" & c).Copy After:=Sheets(Sheets.Count)
              With Sheets(Sheets.Count)
                .Name = sName
                wsM.Range("C3:C8").Copy Destination:=.Range("C9")
                wsM.Range("H3:H8").Copy Destination:=.Range("H9")
                wsM.Range("J11").Copy Destination:=.Range("B23")
                wsM.Range("J12:J13").Copy Destination:=.Range("B9")
                wsM.Range("J14").Copy Destination:=.Range("B32")
                wsM.Range("J15").Copy Destination:=.Range("I28")
              End With
            End If
          End If
        Next r
      Next c
    End With
  End With
  Application.ScreenUpdating = True
End Sub

.. and if you would like all the 'Type' sheets grouped by Type and by the following numbers, try this one

Sub Create_Sheets_v3()
  Dim d As Object, AL As Object
  Dim wsM As Worksheet, ws As Worksheet
  Dim itm As Variant
  Dim rngTemplateNumbers As Range
  Dim r As Long, c As Long
  Dim sName As String
  Dim bSheetAdded As Boolean
  
  Set d = CreateObject("Scripting.Dictionary")
  Set wsM = Sheets("Master")
  Application.ScreenUpdating = False
  With wsM
    Set rngTemplateNumbers = .Range("C12:E15")
    With rngTemplateNumbers
      For c = 1 To .Columns.Count
        For r = 1 To .Rows.Count
          If Len(.Cells(r, c).Value) > 0 Then
            sName = "Type" & c & "-" & .Cells(r, c).Value
            d(sName) = d(sName) + 1
            If d(sName) > 1 Then sName = sName & -d(sName)
            Set ws = Nothing
            On Error Resume Next
            Set ws = Sheets(sName)
            On Error GoTo 0
            If ws Is Nothing Then
              Sheets("Temp" & c).Copy After:=Sheets(Sheets.Count)
              bSheetAdded = True
              With Sheets(Sheets.Count)
                .Name = sName
                wsM.Range("C3:C8").Copy Destination:=.Range("C9")
                wsM.Range("H3:H8").Copy Destination:=.Range("H9")
                wsM.Range("J11").Copy Destination:=.Range("B23")
                wsM.Range("J12:J13").Copy Destination:=.Range("B9")
                wsM.Range("J14").Copy Destination:=.Range("B32")
                wsM.Range("J15").Copy Destination:=.Range("I28")
              End With
            End If
          End If
        Next r
      Next c
    End With
  End With
  If bSheetAdded Then
    Set AL = CreateObject("System.Collections.ArrayList")
    For Each ws In Worksheets
      If ws.Name Like "Type*" Then AL.Add ws.Name
    Next ws
    AL.Sort
    For Each itm In AL
      Sheets(itm).Move After:=Sheets(Sheets.Count)
    Next itm
  End If
  Application.ScreenUpdating = True
End Sub

 

[vlacombe]

Hi Peter,

It seems the script doesnt like to copy from OR to copy to merged cells.
I get runtime error "1004": We can't do that to a merged cells

I'm using the latest iteration you sent (Create_Sheets_v3)
The script stop at: wsM.Range("D4:D9").Copy Destination:=.Range("C9")

If this is pertinent info, the sript doesnt reach all the For for c and r and therefore, stops at creating only 1 sheets without copying any range

Is there a way around this with merged cells?

 

[Peter_SSs]

VBA and merged cells often do not sit well together and you didn't tell us about those. What cells are merged and on what sheet(s)?

 

[vlacombe]

My mistake Peter
Believe when I say I'm a complete newbie when it comes to VBA excel scripting
I have always assumed it would work without problem kind of like formulas

for instance if I merge A1:B2 and I want C1:2 to equal the value of the merged cell, I always refer to top left cell of the merged ones... in this case A1... I assumed it wasn't an issue with VBA script

I will be able to answer you tomorrow when I get back at my office... although I can confirm you right now, I do recall there was merged cells on both sheets, merged by the rows only if I recall correctly, perhaps not the exact same amount of merged cells on each sheets ("master" and the 3 templates)
I may be able to get away with it by unmerging them from the master sheet, but not much from my 3 templates

 

[vlacombe]

Hi Peter,

Here is the merged cells list that are being copied over or onto

On the master sheet:
C3 to C8 and H3 to H8 are all merged horizontaly only, 3 cells wide, so C3 as I first taugh is actually C3 to E3, and so long with the other cells

On all 3 templates:
C9 to C14 are merged 2 cells wide horitontaly, so C9 is actually C9:D9 and so long. And H9 to H14 is 3 cells wide, H9 is H9:J9 and so long...

Checking the sheets right now, unless you have an easy fix/solution, I can probably get away by removing the merged cells on all sheets.

I ran into a different problem which makes the script unsuable to me at this current state.
All the cells copied from the master that needs to go to all templates when copied have different destinations for each type... (Type1 when value in col. C Type2 when value in col. D and Type3 when value in col. E)
Not sure if I'm being clear enough, excuse me but english isn't my native language.
If I try to explain myself differently, The cells it copies from the master sheets are always the same at the exact same cells... but the destination cells are different for type1, type2 and type3 templates

Could you help me reorganise the script so that for every type of sheet it creates, it has it's own section in the script for destination cells... you could simply paste the "copy from/copy to" with the same cell ranges 3 times, I will fix the destination myself in the script.

I feel like I'm asking you too much already so don't worry too much about the merged cells issue. Thanks a lot!

 

[Peter_SSs]

On all 3 templates:
C9 to C14 are merged 2 cells wide horitontaly, so C9 is actually C9:D9 and so long. And H9 to H14 is 3 cells wide, H9 is H9:J9 and so long...


I ran into a different problem which makes the script unsuable to me at this current state.
All the cells copied from the master that needs to go to all templates when copied have different destinations for each type... (Type1 when value in col. C Type2 when value in col. D and Type3 when value in col. E)

I don't really undersatnd the 'different problem' described here. Since you said on all 3 templates C9:D9 are merged, as are C10:D10 etc then how can any data get copied into col D as you described for Type2 since column D is already merged with column C so it doesn't exist on its own - at least for rows 9:14. Or are you talking about elsewhere? Needs clarification. Specific examples?

Forgetting that for a moment, I think this change should get the values from the merged cells in master to the merged cells in the templates, assuming those template merged cells are indeed all in the same place as described in the first part of my quote here.

Try making these changes.

<del>wsM.Range("C3:C8").Copy Destination:=.Range("C9")
wsM.Range("H3:H8").Copy Destination:=.Range("H9")</del>
.Range("C9:C14").Value = wsM.Range("C3:C8").Value
.Range("H9:H14").Value = wsM.Range("H3:H8").Value