VBA - duplicate sheets based on drop-down list in another worksheet

[MossyPants]

Hi all, just starting out with VBA and I'm having trouble piecing this one together.

I have a worksheet called "chooser" that contains 4 drop-down lists in cells A1-A4. The drop-down lists contain numbers 0-10.

I would like to duplicate some hidden worksheets (named "apples", "oranges", etc) based on the selection in the drop-down list in "chooser".

For example, if user selects "3" from drop-down list in A1, I would like to duplicate hidden worksheet called "apples" 3 times and name them "apples1","apples 2", and "apples3".

If user selects "1" from drop-down list in A2, I would like to duplicate worksheet called "oranges" and name it "oranges2".

Hope this question is clear. Any help is greatly appreciated!

 

[MossyPants]

This will have to be a sheet cell change event. script
So when a change is made to range A1 or A2 Or A3 or A4
The script would run doing it the way you want.
So I'm going to let someone else help you.
I will keep watching through.

Thank you for the nudge in the right direction. Here's what I've come up with so far (it only considers the value in cell A1 at the moment):

Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next

If Target.Address = "$A$1" Then
    For n = 1 To Target.Value
        MyCount = ActiveWorkbook.Sheets.Count
        ActiveWorkbook.Sheets("Apples").Visible = True
        ActiveWorkbook.Sheets("Apples").Copy After:=ActiveWorkbook.Sheets(MyCount)
        ActiveWorkbook.Sheets(MyCount + 1).Name = "Apples" + Format(n)
        ActiveWorkbook.Sheets("Apples").Visible = False
    Next n
End If

End Sub

 

[Peter_SSs]

Try this with a copy of your workbook.
Be aware that any relevantly named existing sheets are deleted any time a value in A1:A4 is 'changed'. So if A1 is 3 and there are 3 Apples sheets, those 3 Apples sheets will be deleted even if 3 is re-chosen in A1

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim changed As Range, c As Range
  Dim mySheets As Variant
  Dim ShtName As String
  Dim i As Long

  mySheets = Split("Apples?Oranges?Bananas?Plums", "?")
  
  Set changed = Intersect(Target, Range("A1:A4"))
  If Not changed Is Nothing Then
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    For Each c In changed
      ShtName = mySheets(c.Row - 1)
      For i = Sheets.Count To 1 Step -1
        With Sheets(i)
          If .Visible = True Then
            If InStr(1, .Name, ShtName, 1) = 1 Then .Delete
          End If
        End With
      Next i
      With Sheets(ShtName)
        .Visible = True
        For i = c.Value To 1 Step -1
          .Copy After:=Sheets(.Name)
          ActiveSheet.Name = ShtName & i
        Next i
        .Visible = xlHidden
      End With
    Next c
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
  End If
End Sub

 

[My Aswer Is This]

Thank you for the nudge in the right direction. Here's what I've come up with so far (it only considers the value in cell A1 at the moment):

Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next

If Target.Address = "$A$1" Then
    For n = 1 To Target.Value
        MyCount = ActiveWorkbook.Sheets.Count
        ActiveWorkbook.Sheets("Apples").Visible = True
        ActiveWorkbook.Sheets("Apples").Copy After:=ActiveWorkbook.Sheets(MyCount)
        ActiveWorkbook.Sheets(MyCount + 1).Name = "Apples" + Format(n)
        ActiveWorkbook.Sheets("Apples").Visible = False
    Next n
End If

End Sub

Well you have the first one now you will need three more.

I still think it would be a lot easier to have the sheet names in a Datavalidation list in range A1
And a DataValidation list in range A2 with your mumber

And the script would run when you select the sheet name in Range("A1")
Not sure why you need a DataValization list with just a bunch of numbers

 

[MossyPants]

Well you have the first one now you will need three more.

I still think it would be a lot easier to have the sheet names in a Datavalidation list in range A1
And a DataValidation list in range A2 with your mumber

And the script would run when you select the sheet name in Range("A1")
Not sure why you need a DataValization list with just a bunch of numbers

If I'm understanding your suggestion correctly, this would only allow me to choose one fruit at a time. What if I want 3 apples worksheets and 4 plums worksheets?

 

[My Aswer Is This]

If I'm understanding your suggestion correctly, this would only allow me to choose one fruit at a time. What if I want 3 apples worksheets and 4 plums worksheets?

First question:
Did the script Peter wrote work for you?
If so that's great

If you wanted 3 Apple
And 4 plumn work sheets
You first enter the number you want in A2
Then select Apple from the DataValidation in A1 and the script would run when you choose Apple and it would make you the Apple sheets
Then you would enter number in A2 And select Plumn from Datavalidation list in A1
And the script runs when you select the sheet name from DataValidation list in A1

 

[MossyPants]

Try this with a copy of your workbook.
Be aware that any relevantly named existing sheets are deleted any time a value in A1:A4 is 'changed'. So if A1 is 3 and there are 3 Apples sheets, those 3 Apples sheets will be deleted even if 3 is re-chosen in A1

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim changed As Range, c As Range
  Dim mySheets As Variant
  Dim ShtName As String
  Dim i As Long

  mySheets = Split("Apples?Oranges?Bananas?Plums", "?")
 
  Set changed = Intersect(Target, Range("A1:A4"))
  If Not changed Is Nothing Then
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    For Each c In changed
      ShtName = mySheets(c.Row - 1)
      For i = Sheets.Count To 1 Step -1
        With Sheets(i)
          If .Visible = True Then
            If InStr(1, .Name, ShtName, 1) = 1 Then .Delete
          End If
        End With
      Next i
      With Sheets(ShtName)
        .Visible = True
        For i = c.Value To 1 Step -1
          .Copy After:=Sheets(.Name)
          ActiveSheet.Name = ShtName & i
        Next i
        .Visible = xlHidden
      End With
    Next c
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
  End If
End Sub

This is PERFECT. Thank you!!
That code took me a while to parse and understand. I am in awe of your VBA skills

 

[Peter_SSs]

You're welcome. Thanks for the follow-up.

 

[Peter_SSs]

BTW, I think @My Aswer Is This's suggestion for how to set this up is a good one as it more easily allows change of sheet names and/or addition/deletion of other sheets. It also avoids having to hard-code any sheet names into the vba.
You could do it like this.

Set up the chooser sheet with a list of sheet names like I have in column E below and make that into a formal Excel table (select a cell in the table then Ctrl+T is one way). The advantage of the formal table is that it will easily expand/contract if more sheets are added or deleted and can easily be referred to in the Data Validation as I have done below in A2.
(Actually the table of sheet names could be anywhere, even on another sheet if you want.)

MossyPants_1.xlsm
	A	B	C	D	E
1	Sheet Name	Number			SheetNames
2	Plums	2			Apples
3					Oranges
4					Bananas
5					Plums
6
7
chooser

Cells with Data Validation
Cell	Allow	Criteria
A2	List	=INDIRECT("Table1[SheetNames]")
B2	List	0,1,2,3,4,5,6,7,8,9,10

Then use the following Worksheet_Change code for the chooser sheet. Rather than have to remember to do the drop-downs in a specific order, this code exits if either A2 or B2 are empty and if both have values it checks if you are ready to proceed. So, for example, if we have already created the 2 Plum sheets based on the values below and you then want to create 3 Apple sheets you can change either A2 or B2 first. If you change A2 to Apple first, the code will ask if you want to create 2 Apple sheets so you would say No and then enter 3 in B2 and the code will ask if you want to create 3 Apple sheets to which you would answer Yes. If you want to avoid that first 'No' question then simply select A2:B2 and delete before making your new choices.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim ShtName As String
  Dim i As Long, Num As Long
  Dim Resp As VbMsgBoxResult
  
  If Not Intersect(Target, Range("A2:B2")) Is Nothing Then
    If Not IsEmpty(Range("A2").Value) And Not IsEmpty(Range("B2").Value) Then
      ShtName = Range("A2").Value
      Num = Range("B2").Value
      Resp = MsgBox("Are you sure you want to delete any existing '" & ShtName & "' sheets" & vbLf & _
                    "and create " & Num & " new ones?", vbYesNoCancel)
      If Resp = vbYes Then
        Application.DisplayAlerts = False
        Application.ScreenUpdating = False
        For i = Sheets.Count To 1 Step -1
          With Sheets(i)
              If InStr(1, .Name, ShtName, 1) = 1 And Len(.Name) > Len(ShtName) Then .Delete
          End With
        Next i
        With Sheets(ShtName)
          .Visible = True
          For i = Num To 1 Step -1
            .Copy After:=Sheets(.Name)
            ActiveSheet.Name = ShtName & i
          Next i
          .Visible = xlHidden
        End With
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True
      End If
    End If
  End If
End Sub

 

[MossyPants]

BTW, I think @My Aswer Is This's suggestion for how to set this up is a good one as it more easily allows change of sheet names and/or addition/deletion of other sheets. It also avoids having to hard-code any sheet names into the vba.
You could do it like this.

Set up the chooser sheet with a list of sheet names like I have in column E below and make that into a formal Excel table (select a cell in the table then Ctrl+T is one way). The advantage of the formal table is that it will easily expand/contract if more sheets are added or deleted and can easily be referred to in the Data Validation as I have done below in A2.
(Actually the table of sheet names could be anywhere, even on another sheet if you want.)

MossyPants_1.xlsm
	A	B	C	D	E
1	Sheet Name	Number			SheetNames
2	Plums	2			Apples
3					Oranges
4					Bananas
5					Plums
6
7
chooser

Cells with Data Validation
Cell	Allow	Criteria
A2	List	=INDIRECT("Table1[SheetNames]")
B2	List	0,1,2,3,4,5,6,7,8,9,10

Then use the following Worksheet_Change code for the chooser sheet. Rather than have to remember to do the drop-downs in a specific order, this code exits if either A2 or B2 are empty and if both have values it checks if you are ready to proceed. So, for example, if we have already created the 2 Plum sheets based on the values below and you then want to create 3 Apple sheets you can change either A2 or B2 first. If you change A2 to Apple first, the code will ask if you want to create 2 Apple sheets so you would say No and then enter 3 in B2 and the code will ask if you want to create 3 Apple sheets to which you would answer Yes. If you want to avoid that first 'No' question then simply select A2:B2 and delete before making your new choices.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim ShtName As String
  Dim i As Long, Num As Long
  Dim Resp As VbMsgBoxResult
 
  If Not Intersect(Target, Range("A2:B2")) Is Nothing Then
    If Not IsEmpty(Range("A2").Value) And Not IsEmpty(Range("B2").Value) Then
      ShtName = Range("A2").Value
      Num = Range("B2").Value
      Resp = MsgBox("Are you sure you want to delete any existing '" & ShtName & "' sheets" & vbLf & _
                    "and create " & Num & " new ones?", vbYesNoCancel)
      If Resp = vbYes Then
        Application.DisplayAlerts = False
        Application.ScreenUpdating = False
        For i = Sheets.Count To 1 Step -1
          With Sheets(i)
              If InStr(1, .Name, ShtName, 1) = 1 And Len(.Name) > Len(ShtName) Then .Delete
          End With
        Next i
        With Sheets(ShtName)
          .Visible = True
          For i = Num To 1 Step -1
            .Copy After:=Sheets(.Name)
            ActiveSheet.Name = ShtName & i
          Next i
          .Visible = xlHidden
        End With
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True
      End If
    End If
  End If
End Sub

Appreciate this. Definitely a more elegant way to scale this.

 

[Peter_SSs]

Appreciate this. Definitely a more elegant way to scale this.

Cheers.