Use of a Userform to Create copies of hidden Excel sheets

Excel gods,
Once again I come in supplication with help on what appears to be a rather simple macro/procedure I want my workbook to perform.

Scenario:
I have a workbook with 6 hidden sheets (Sheet4, Sheet5, Sheet6, Sheet7, Sheet8, Sheet10).

I also have a Userform I created called UserForm1 userformimage.jpg

In the Main Sheet (Sheet3) I have several shapes (all Rectangles) that I will be attaching this required Macro too.

Actions:
I want a macro that activates when the user clicks on the rectangle that does the following:

A) Pulls up the Userform1 (see image above)

B) if the User selects the first Command Button (CommandButton1 that has the label "Port Arrival Report"), a Message/question Box Pops up saying "Are you sure you want to create a Port Arrival Report(CommandButton1 label)? Y/N"
if the user selects "YES", then a copy of hidden Sheet4 is created and the name of the newly created copy of Sheet4 is named based on the values "Arrival", the value in cell AF21 in Sheet3 & the current date.
(e.g. if Cell AF21 has the value "Port5_Discharge" and the macro was run on the date June 20, 2015, then the name of the copied sheet would be "Arrival _Port5_Discharge_Jun20").

Note: if the new sheet created already has a sheet with the same name, in (B) above, then add an increasing number to the end of the name (e.g. the copied sheet would be "Arrival _Port5_Discharge_Jun20" or "Arrival _Port5_Discharge_Jun20(2)"..etc . Also please note that the value in AF21 is reference from another cell

C) Once the new sheet is created, a pop up saying " The "Port Arrival Report" "Name of new worksheet" has been created"

The hidden Sheet4 will remain hidden but the newly created worksheet will be visible.




Now I would love for the macro to carry out the exact same actions for the remaining 5 Command buttons in the Userform1;

i) CommandButton2 "Port Departure Report" will generate copy of hidden Sheet6. Worksheet name based on same rules as above with the name of the copied sheet would be "Depart _Port5_Discharge_Jun20").

ii) CommandButton3 "Port Progress Report" will generate copy of hidden Sheet5. Worksheet name based on same rules as above with the name of the copied sheet would be "Progress _Port5_Discharge_Jun20").

iii) CommandButton4 "Noon Report" will generate copy of hidden Sheet7. Worksheet name based on same rules as above with the name of the copied sheet would be "Noon _Port5_Discharge_Jun20").

iv) CommandButton5 "Port Evaluation" will generate copy of hidden Sheet8. Worksheet name based on same rules as above with the name of the copied sheet would be "PE _Port5_Discharge_Jun20").

v) CommandButton6 "Bunker Evaluation" will generate copy of hidden Sheet10. Worksheet name based on same rules as above with the name of the copied sheet would be "Bunker _Port5_Discharge_Jun20").

PLS note that the second Message/question Box Pops up saying "Are you sure you want to create a (CommandButton label name)? Y/N"

Thanks in advance so much for your help!!!

Hi Harry,

I'm working on your problem.

Some of the Sheet names exceed the Excel 31 Character limitation when there is a duplicate. For example, 'Arrival_Port5_Discharge_Jul31(2)' is 32 characters long and 'Progress_Port5_Discharge_Jul31(2)' is 33 characters long.

Lewis

Originally Posted by LJMetzger

Hi Harry,

I'm working on your problem.

Some of the Sheet names exceed the Excel 31 Character limitation when there is a duplicate. For example, 'Arrival_Port5_Discharge_Jul31(2)' is 32 characters long and 'Progress_Port5_Discharge_Jul31(2)' is 33 characters long.

Lewis

Thanks Lewis. Perhaps another way around that 31 character limitation is to use only the first 4 letters of the first word, in this case instead of 'Arrival_Port5_Discharge_Jul31(2)' it can be "Arri__Port5_Discharge_Jul31(2)"

Thanks!!!

Try the attached file which contains the following new code. I piggybacked the file on top of the file I did last month, because I was able to reuse some of that code.

ThisWorkbook Module:

Option Explicit

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

  Dim sSheetName As String
  
  'If 'A1' is 'Double Clicked' in any Sheet put the focus on 'Sheet1', Cell 'A1'
  If Not Intersect(Target, Range("A1")) Is Nothing Then

    'Get the Sheet Name
    'Put the focus on 'Sheet1' Cell 'A1'
    sSheetName = Sh.Name
    ThisWorkbook.Sheets("Sheet1").Select
    ThisWorkbook.Sheets("Sheet1").Range("A1").Select
    
    'Return normal focus to Excel
    Cancel = True

  End If
  
End Sub

UserForm1 Module:

Option Explicit

Private Sub UserForm_Initialize()
 
  Dim ws As Worksheet
  Dim sSheetName As String
  
  With Label1
    .Font.Name = "Arial"
    .Font.Size = 10
    .Font.Bold = True
    .ForeColor = vbRed
  End With

  With Label2
    .Font.Name = "Arial"
    .Font.Size = 10
    .Font.Bold = True
    .ForeColor = vbGreen
  End With

  With CommandButton1
    .Font.Name = "Arial"
    .Font.Size = 10
    .Font.Bold = True
    .ForeColor = vbBlue
  End With

  With CommandButton2
    .Font.Name = "Arial"
    .Font.Size = 10
    .Font.Bold = True
    .ForeColor = vbBlue
  End With

  With CommandButton3
    .Font.Name = "Arial"
    .Font.Size = 10
    .Font.Bold = True
    .ForeColor = vbBlue
  End With

  With CommandButton4
    .Font.Name = "Arial"
    .Font.Size = 10
    .Font.Bold = True
    .ForeColor = vbBlue
  End With

  With CommandButton5
    .Font.Name = "Arial"
    .Font.Size = 10
    .Font.Bold = True
    .ForeColor = vbBlue
  End With

  With CommandButton6
    .Font.Name = "Arial"
    .Font.Size = 10
    .Font.Bold = True
    .ForeColor = vbBlue
  End With

  With ListBox1
    .Font.Name = "Arial"
    .Font.Size = 10
    .Font.Bold = True
    .ForeColor = vbBlue
  End With
  
  'Put all Sheet Names containing UnderScores in the 'ListBox'
  Call PopulateUserForm1ListBox1
  
End Sub

Private Sub CommandButton1_Click()
  Call CreateCloneSheet("Arrival", "From UserForm")
End Sub

Private Sub CommandButton2_Click()
  Call CreateCloneSheet("Depart", "From UserForm")
End Sub

Private Sub CommandButton3_Click()
  Call CreateCloneSheet("Progress", "From UserForm")
End Sub

Private Sub CommandButton4_Click()
  Call CreateCloneSheet("Noon", "From UserForm")
End Sub

Private Sub CommandButton5_Click()
  Call CreateCloneSheet("PE", "From UserForm")
End Sub

Private Sub CommandButton6_Click()
  Call CreateCloneSheet("Bunker", "From UserForm")
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  'This goes to the Sheet Selected and Closes the UserForm

  Dim sSheetName As String
  
  'Get the Sheet Name
  'Make the Sheet the Active Sheet
  'Close the UserForm
  sSheetName = ListBox1.Value
  ThisWorkbook.Sheets(sSheetName).Select
  Unload Me
End Sub

Ordinary Code Module ModFormSheetGeneration:

Option Explicit

Sub DisplayUserForm1()
  UserForm1.Show vbModal      'This locks out all Worksheet Resources
  'UserForm1.Show vbModeless   'This enables access to Worksheet Resources - useful during debugging
End Sub

Sub CreatePortArrivalSheet()
  Call CreateCloneSheet("Arrival")
End Sub

Sub CreatePortDepartureSheet()
  Call CreateCloneSheet("Depart")
End Sub


Sub CreatePortProgressSheet()
  Call CreateCloneSheet("Progress")
End Sub

Sub CreateNoonSheet()
  Call CreateCloneSheet("Noon")
End Sub

Sub CreatePortEvaluationSheet()
  Call CreateCloneSheet("PE")
End Sub

Sub CreateBunkerEvaluationSheet()
  Call CreateCloneSheet("Bunker")
End Sub

Sub CreateCloneSheet(sSheetDescription As String, Optional sSourceOfRequest As String)

  Dim wks As Worksheet

  Dim iCount As Long
  Dim iReply As Long
  Dim iSourceSheetOriginalVisibility As Long       'This must be a type 'long' and not a type 'boolean'

  Dim bIllegalCharacterInSheetName As Boolean
  Dim bNeedMore As Boolean

  Dim sBaseNewSheetName As String
  Dim sDestinationSheetName As String
  Dim sDestinationSheetPreambleName As String
  Dim sDestinationSheetDescription As String
  Dim sMasterSheetCloneName As String
  Dim sSheetName As String
  Dim sSourceSheetName As String
  Dim sValueFromAF21 As String

  
  'Get the Source Sheet Name
  Select Case sSheetDescription
  
    Case "Arrival"
      sSourceSheetName = "ArrivalMaster"
      sDestinationSheetDescription = "Port Arrival Report"

    Case "Depart"
      sSourceSheetName = "DepartMaster"
      sDestinationSheetDescription = "Port Departure Report"

    Case "Progress"
      sSourceSheetName = "ProgressMaster"
      sDestinationSheetDescription = "Port Progress Report"

    Case "Noon"
      sSourceSheetName = "NoonMaster"
      sDestinationSheetDescription = "Noon Report"

    Case "PE"
      sSourceSheetName = "PEMaster"
      sDestinationSheetDescription = "Port Evaluation Report"

    Case "Bunker"
      sSourceSheetName = "BunkerMaster"
      sDestinationSheetDescription = "Bunker Evaluation Report"

  End Select
  
  'Verify that the User wants to create the New Sheet
  iReply = MsgBox(Buttons:=vbYesNo, _
           Title:= _
           "Create New Sheet Selection", _
           Prompt:= _
           "Select 'Yes' to Create a New '" & sDestinationSheetDescription & "' Sheet." & vbCrLf & _
           "Select 'No'  to do NOTHING.")
    
  If iReply = vbNo Then
    MsgBox "NOTHING DONE per User request."
    Exit Sub
  End If
  
  
  
  'Get the value from Cell 'AF21'
  sValueFromAF21 = ActiveSheet.Range("AF21").Value
  
  
  'Create the Destination Sheet Name
  'Limit the Sheet Preamble Name to 4 characters
  sDestinationSheetPreambleName = sSheetDescription
  If Len(sDestinationSheetPreambleName) > 4 Then
    sDestinationSheetPreambleName = Left(sDestinationSheetPreambleName, 4)
  End If
  sBaseNewSheetName = sDestinationSheetPreambleName & "_" & sValueFromAF21 & "_" & Format(Now(), "mmmdd")
  
  'Loop until a UNIQUE 'New Sheet Name' has been found
  'or TERMINATE if an error occurs in the 'New Sheet Name'
  bNeedMore = True
  While bNeedMore = True
    
    'Increment the 'Duplicate' Counter
    'Create the proposed 'New Sheet Name'
    iCount = iCount + 1
    If iCount = 1 Then
      sDestinationSheetName = sBaseNewSheetName
    Else
      sDestinationSheetName = sBaseNewSheetName & "(" & iCount & ")"
    End If
      
    'Terminate if the Count exceeds an arbitrary limit
    If iCount > 99 Then
      MsgBox "NOTHING DONE." & vbCrLf & _
             "The New 'Sheet Name' exceeds the ARBITRARY duplicate limitation of 99." & vbCrLf & _
             "New Sheet Name: '" & sDestinationSheetName & "'"
      GoTo MY_EXIT
    End If
      
    'Terminate if the New 'Sheet Name' exceeds the 31 character name limitation
    'NOTE: No checking is done for illegal characters in the name
    If Len(sDestinationSheetName) > 31 Then
      MsgBox "NOTHING DONE." & vbCrLf & _
             "The New 'Sheet Name' exceeds the Excel 31 character limitation." & vbCrLf & _
             "New Sheet Name: '" & sDestinationSheetName & "'" & vbCrLf & _
             "Number of characters: " & Len(sDestinationSheetName)
      GoTo MY_EXIT
    End If
      
    'Terminate if the 'New Sheet Name' contains illegal characters
    bIllegalCharacterInSheetName = DoesSheetNameContainIllegalCharacters(sDestinationSheetName)
    If bIllegalCharacterInSheetName = True Then
      MsgBox "NOTHING DONE." & vbCrLf & _
             "The New 'Sheet Name' has an ILLEGAL Character." & vbCrLf & _
             "Illegal Characters include:  : \ / ? * [ ]" & vbCrLf & _
             "New Sheet Name: '" & sDestinationSheetName & "'"
      GoTo MY_EXIT
    End If
      
    'Exit the Loop if the 'Sheet Name' DOES NOT EXIST
    'It is now OK to create the new Sheet
    If LjmSheetExists(sDestinationSheetName) = False Then
      bNeedMore = False
    End If
  Wend
  
  'Delete all Unauthorized Master Sheet Clones (e.g. 'PEMaster (2) etc) which should not exist
  Application.DisplayAlerts = False         'Inhibit 'Do you really want to delete ... message'
  For Each wks In ThisWorkbook.Worksheets
    sSheetName = wks.Name
    If sSheetName Like "Master (*" Then
      wks.Visible = xlSheetHidden
      wks.Delete
    End If
  Next wks
  Application.DisplayAlerts = True
  
  'Unhide a VeryHidden 'Source Sheet' if Needed
  iSourceSheetOriginalVisibility = ThisWorkbook.Worksheets(sSourceSheetName).Visible
  If iSourceSheetOriginalVisibility = xlSheetVeryHidden Then
    ThisWorkbook.Worksheets(sSourceSheetName).Visible = xlSheetHidden
  End If
    
    
  'Make a copy of the 'Source Sheet' (as the Last Sheet in the Workbook)
  ThisWorkbook.Worksheets(sSourceSheetName).Copy After:=ThisWorkbook.Sheets(Sheets.Count)
    
  'Change the name of the 'New' Sheet
  'Make the new Sheet visible
  sMasterSheetCloneName = sSourceSheetName & " (2)"
  Set wks = Sheets(sMasterSheetCloneName)
  wks.Name = sDestinationSheetName
  wks.Visible = xlSheetVisible
        
  'Hide a VeryHidden 'Sheet2' if it was originally 'Very Hidden'
  If iSourceSheetOriginalVisibility = xlSheetVeryHidden Then
    ThisWorkbook.Worksheets(sSourceSheetName).Visible = xlSheetVeryHidden
  End If
    
  'If the request came from the 'ListBox', then update the ListBox contents
  If sSourceOfRequest = "From UserForm" Then
    Call PopulateUserForm1ListBox1
  End If
  
  'Turn on Screen Updating
  Application.ScreenUpdating = True
  
  MsgBox "New Sheet SUCCESSFULLY created." & vbCrLf & _
         "New Sheet Name: '" & sDestinationSheetName & "'"
         
                    
MY_EXIT:
  'Turn on Screen Updating
  Application.ScreenUpdating = True
  
  'Put the Focus on 'Sheet1'
  Sheets("Sheet1").Select
  
  'Clear object pointer
  Set wks = Nothing
  
End Sub

Sub PopulateUserForm1ListBox1()
  'This clears the UserForm 'ListBox', and then populates the 'ListBox'
  'with all Sheet Names that contain an Underscore

  Dim ws As Worksheet
  Dim sSheetName As String
  
  'Clear the contents of the ListBox
  UserForm1.ListBox1.Clear
  
  'Populate the ListBox
  For Each ws In ThisWorkbook.Worksheets
    sSheetName = ws.Name
  
    If sSheetName Like "*_*" Then
      UserForm1.ListBox1.AddItem sSheetName
    End If
  Next ws

End Sub


Sub MakeAllMasterSheetsVisible()
  ThisWorkbook.Worksheets("ArrivalMaster").Visible = xlSheetVisible
  ThisWorkbook.Worksheets("DepartMaster").Visible = xlSheetVisible
  ThisWorkbook.Worksheets("ProgressMaster").Visible = xlSheetVisible
  ThisWorkbook.Worksheets("NoonMaster").Visible = xlSheetVisible
  ThisWorkbook.Worksheets("PEMaster").Visible = xlSheetVisible
  ThisWorkbook.Worksheets("BunkerMaster").Visible = xlSheetVisible
End Sub

Sub MakeAllMasterSheetsHidden()
  ThisWorkbook.Worksheets("ArrivalMaster").Visible = xlHidden
  ThisWorkbook.Worksheets("DepartMaster").Visible = xlHidden
  ThisWorkbook.Worksheets("ProgressMaster").Visible = xlHidden
  ThisWorkbook.Worksheets("NoonMaster").Visible = xlHidden
  ThisWorkbook.Worksheets("PEMaster").Visible = xlHidden
  ThisWorkbook.Worksheets("BunkerMaster").Visible = xlHidden
End Sub

Sub MakeAllMasterSheetsVeryHidden()
  ThisWorkbook.Worksheets("ArrivalMaster").Visible = xlSheetVeryHidden
  ThisWorkbook.Worksheets("DepartMaster").Visible = xlSheetVeryHidden
  ThisWorkbook.Worksheets("ProgressMaster").Visible = xlSheetVeryHidden
  ThisWorkbook.Worksheets("NoonMaster").Visible = xlSheetVeryHidden
  ThisWorkbook.Worksheets("PEMaster").Visible = xlSheetVeryHidden
  ThisWorkbook.Worksheets("BunkerMaster").Visible = xlSheetVeryHidden
End Sub

Sub DeleteAllSheetsThatContainAnUnderScore()

  Dim ws As Worksheet
  Dim sSheetName As String
  
  'Inhibit 'Do you really want to Delete prompt'
  Application.DisplayAlerts = False
  
  For Each ws In ThisWorkbook.Worksheets
    sSheetName = ws.Name
  
    If sSheetName Like "*_*" Then
      ws.Delete
      'Debug.Print sSheetName
    End If
   
  Next ws
  
  'Enable 'Do you really want to Delete prompt'
  Application.DisplayAlerts = True
  
End Sub

Lewis

Thanks LJMetzger,
I have adopted the codes you graciously provided into my worksheet but upon the opening of the form I get the below error when i click the first (Port Arrival) commandbutton...

Sub CreateCloneSheet_error1.jpg
from the Sub CreateCloneSheet macro found in the ModFormSheetGeneration Module

I've tried looking for any differences in code in both workbook cant find any...pls help )

It's my fault Harry for not explaining better. There are some utility routines I reused from your previous post, that I included in the download file, but were not included in the cut and paste code above.

Make sure you backup your file.
Please make sure that none of the following routines are duplicated in your file or Excel may lock up when you attempt to open the file after saving.

The following routines should be in module ModCloneSheet2 in the download file in post #4 in this thread. You can get them from the file or cut and paste from below:

Sub LjmCreateCellBorder(myRange As Range, myRGBColor As Long, iBorderThickness As Long)
  'This creates a Continuous Thick Cell border around each cell in a range

  Dim r As Range
  
  For Each r In myRange
    With r.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = iBorderThickness
        If myRGBColor = xlAutomatic Or myRGBColor = xlNone Then
          .ColorIndex = myRGBColor
        Else
          .Color = myRGBColor
        End If
    End With
    With r.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = iBorderThickness
        If myRGBColor = xlAutomatic Or myRGBColor = xlNone Then
          .ColorIndex = myRGBColor
        Else
          .Color = myRGBColor
        End If
    End With
    With r.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = iBorderThickness
        If myRGBColor = xlAutomatic Or myRGBColor = xlNone Then
          .ColorIndex = myRGBColor
        Else
          .Color = myRGBColor
        End If
    End With
    With r.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = iBorderThickness
        If myRGBColor = xlAutomatic Or myRGBColor = xlNone Then
          .ColorIndex = myRGBColor
        Else
          .Color = myRGBColor
        End If
    End With
    
  Next r

End Sub

Public Function LjmSheetExists(SheetName As String) As Boolean
  'Return value TRUE if sheet exists

  On Error Resume Next

  If Sheets(SheetName) Is Nothing Then
    LjmSheetExists = False
  Else
    LjmSheetExists = True
  End If
  On Error GoTo 0
  
End Function

Function DoesSheetNameContainIllegalCharacters(sNewSheetName As String) As Boolean
  'This returns 'True' if the Input 'Sheet Name' contains illegal characters
  'Illegal Characters include:  : \ / ? * [ ]
  
  If InStr(sNewSheetName, ":") > 0 Then DoesSheetNameContainIllegalCharacters = True
  If InStr(sNewSheetName, "\") > 0 Then DoesSheetNameContainIllegalCharacters = True
  If InStr(sNewSheetName, "/") > 0 Then DoesSheetNameContainIllegalCharacters = True
  If InStr(sNewSheetName, "?") > 0 Then DoesSheetNameContainIllegalCharacters = True
  If InStr(sNewSheetName, "*") > 0 Then DoesSheetNameContainIllegalCharacters = True
  If InStr(sNewSheetName, "[") > 0 Then DoesSheetNameContainIllegalCharacters = True
  If InStr(sNewSheetName, "]") > 0 Then DoesSheetNameContainIllegalCharacters = True

End Function

Please let me know if you have any more problems.

IT WORKS!!!!! My mistake in not properly going through all the code. I am currently testing for any bugs but so far it is great.

I do have one more minor mod if you can pls assist with this.

The above is all triggered by the "Sub DisplayUserForm1()" attahed to the rectangle and the part of the name of the newly created form is from cell "AF21"

Now I have several of these rectangles each naming the new forms generated from reading from specific cells like above e.g. Rectangle2 is reading from cell "AF22", Rectangle3 is reading from "AF24" and so on and on...


I was looking at the "Sub CreateCloneSheet" macro and wondered if we can modify it to accommodate the above ...???

Thanks

Hi Harry,

I tried to do what you asked for. I hope I understood your request. See the attached file and the code excerpts below. Items in red in the code excerpts highlight major points.

I made wholesale changes to the existing code in module ModFormSheetGeneration and added UserForm0 and UserForm2. There were also small changes to the UserForm code.

You should be able to add to the framework I created to customize to your needs. Everything could have been done in one UserForm, but the method I chose is probably easier for you to follow and maintain.

The UserForms are as follows:
a. UserForm0 (optional) opens the other UserForms as the User requires.
b. UserForm1 is for 'AF21'.
c. UserForm2 is for 'AF22'
d. You can add other UserForms as you require.

UserForm1 code excerpts:

Private Sub CommandButton1_Click()
  Call CreateCloneSheet("AF21", "Arrival", "From UserForm1")
End Sub

Private Sub CommandButton2_Click()
  Call CreateCloneSheet("AF21", "Depart", "From UserForm1")
End Sub

Private Sub CommandButton3_Click()
  Call CreateCloneSheet("AF21", "Progress", "From UserForm1")
End Sub

Private Sub CommandButton4_Click()
  Call CreateCloneSheet("AF21", "Noon", "From UserForm1")
End Sub

Private Sub CommandButton5_Click()
  Call CreateCloneSheet("AF21", "PE", "From UserForm1")
End Sub

Private Sub CommandButton6_Click()
  Call CreateCloneSheet("AF21", "Bunker", "From UserForm1")
End Sub

Excerpts from module ModFormSheetGeneration:

Option Explicit

'Flag to determine if UserForm0 must be opened when another UserForm closes
Public bNeedUserForm0 As Boolean

Sub DisplayUserForm0()

  'NOTE: Due to the nature of UserForm code, if UserForm0 is used all
  '      UserForms must be opened as vbModal
  
  'Set the Flag to Open UserForm0 when UserForm1 or UserForm2 Closes
  'The Flag is cleared when the 'x' in this UserForm is selected
  bNeedUserForm0 = True
  
  UserForm0.Show vbModal      'This locks out all Worksheet Resources

End Sub

Sub DisplayUserForm1()
  
  UserForm1.Show vbModal      'This locks out all Worksheet Resources
  'UserForm1.Show vbModeless   'This enables access to Worksheet Resources - useful during debugging
  
  'Display UserForm0 after this UserForm closes if needed
  If bNeedUserForm0 = True Then
    Call DisplayUserForm0
  End If

End Sub

Sub DisplayUserForm2()
  
  UserForm2.Show vbModal      'This locks out all Worksheet Resources
  'UserForm1.Show vbModeless   'This enables access to Worksheet Resources - useful during debugging
  
  'Display UserForm0 after this UserForm closes if needed
  If bNeedUserForm0 = True Then
    Call DisplayUserForm0
  End If

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Cell 'AF21 Rectangles
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub CreatePortArrivalSheet()
  Call CreateCloneSheet("AF21", "Arrival")
End Sub

Sub CreatePortDepartureSheet()
  Call CreateCloneSheet("AF21", "Depart")
End Sub


Sub CreatePortProgressSheet()
  Call CreateCloneSheet("AF21", "Progress")
End Sub

Sub CreateNoonSheet()
  Call CreateCloneSheet("AF21", "Noon")
End Sub

Sub CreatePortEvaluationSheet()
  Call CreateCloneSheet("AF21", "PE")
End Sub

Sub CreateBunkerEvaluationSheet()
  Call CreateCloneSheet("AF21", "Bunker")
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Cell 'AF22 Rectangles
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub CreateABCSheet()
  Call CreateCloneSheet("AF22", "ABC")
End Sub

Sub CreateDEFSheet()
  Call CreateCloneSheet("AF22", "DEF")
End Sub


Sub CreateCloneSheet(sControlCellAddress As String, sSheetDescription As String, Optional sSourceOfRequest As String)

  Dim wks As Worksheet

  Dim iCount As Long
  Dim iReply As Long
  Dim iSourceSheetOriginalVisibility As Long       'This must be a type 'long' and not a type 'boolean'

  Dim bIllegalCharacterInSheetName As Boolean
  Dim bNeedMore As Boolean

  Dim sBaseNewSheetName As String
  Dim sDestinationSheetName As String
  Dim sDestinationSheetPreambleName As String
  Dim sDestinationSheetDescription As String
  Dim sMasterSheetCloneName As String
  Dim sSheetName As String
  Dim sSourceSheetName As String
  Dim sValueFromControlCell As String

  If sControlCellAddress = "AF21" Then
    'Get the Source Sheet Name
    Select Case sSheetDescription
  
      Case "Arrival"
        sSourceSheetName = "ArrivalMaster"
        sDestinationSheetDescription = "Port Arrival Report"

      Case "Depart"
        sSourceSheetName = "DepartMaster"
        sDestinationSheetDescription = "Port Departure Report"

      Case "Progress"
        sSourceSheetName = "ProgressMaster"
        sDestinationSheetDescription = "Port Progress Report"

      Case "Noon"
        sSourceSheetName = "NoonMaster"
        sDestinationSheetDescription = "Noon Report"

      Case "PE"
        sSourceSheetName = "PEMaster"
        sDestinationSheetDescription = "Port Evaluation Report"

      Case "Bunker"
        sSourceSheetName = "BunkerMaster"
        sDestinationSheetDescription = "Bunker Evaluation Report"

    End Select
  End If
  
  If sControlCellAddress = "AF22" Then
    'Get the Source Sheet Name
    Select Case sSheetDescription
  
      Case "ABC"
        sSourceSheetName = "ArrivalMaster"
        sDestinationSheetDescription = "Port Arrival Report"

      Case "DEF"
        sSourceSheetName = "DepartMaster"
        sDestinationSheetDescription = "Port Departure Report"

      Case "Progress"
        sSourceSheetName = "ProgressMaster"
        sDestinationSheetDescription = "Port Progress Report"

      Case "Noon"
        sSourceSheetName = "NoonMaster"
        sDestinationSheetDescription = "Noon Report"

      Case "PE"
        sSourceSheetName = "PEMaster"
        sDestinationSheetDescription = "Port Evaluation Report"

      Case "Bunker"
        sSourceSheetName = "BunkerMaster"
        sDestinationSheetDescription = "Bunker Evaluation Report"

    End Select
  End If
  
'Set the value of NEED_TO_DEBUG_PROGRAMMING_ERROR to 'True' to debug this routine
'Set the value of NEED_TO_DEBUG_PROGRAMMING_ERROR to 'False' for normal operation
#Const NEED_TO_DEBUG_PROGRAMMING_ERROR = False
#If NEED_TO_DEBUG_PROGRAMMING_ERROR = True Then
  Debug.Assert False
#End If
  
  If Len(sSourceSheetName) = 0 Then
    MsgBox "NOTHING DONE.  Programming Error input into Sub CreateCloneSheet()." & vbCrLf & _
           "Check the value of the 'Control Cell Address' (e.g. 'AF21') or " & vbCrLf & _
           "Check the value of the 'Sheet Description' (e.g. 'Departure' or 'Noon')."
    Exit Sub
  End If

  'Verify that the User wants to create the New Sheet
  iReply = MsgBox(Buttons:=vbYesNo, _
           Title:= _
           "Create New Sheet Selection", _
           Prompt:= _
           "Select 'Yes' to Create a New '" & sDestinationSheetDescription & "' Sheet." & vbCrLf & _
           "Select 'No'  to do NOTHING.")
    
  If iReply = vbNo Then
    MsgBox "NOTHING DONE per User request."
    Exit Sub
  End If
  
  
  
  'Get the value from the Control Cell (e.g. 'AF21')
  sValueFromControlCell = ActiveSheet.Range(sControlCellAddress).Value
  
  
  'Create the Destination Sheet Name
  'Limit the Sheet Preamble Name to 4 characters
  sDestinationSheetPreambleName = sSheetDescription
  If Len(sDestinationSheetPreambleName) > 4 Then
    sDestinationSheetPreambleName = Left(sDestinationSheetPreambleName, 4)
  End If
  sBaseNewSheetName = sDestinationSheetPreambleName & "_" & sValueFromControlCell & "_" & Format(Now(), "mmmdd")
  
  'Loop until a UNIQUE 'New Sheet Name' has been found
  'or TERMINATE if an error occurs in the 'New Sheet Name'
  bNeedMore = True
  While bNeedMore = True
    
    'Increment the 'Duplicate' Counter
    'Create the proposed 'New Sheet Name'
    iCount = iCount + 1
    If iCount = 1 Then
      sDestinationSheetName = sBaseNewSheetName
    Else
      sDestinationSheetName = sBaseNewSheetName & "(" & iCount & ")"
    End If
      
    'Terminate if the Count exceeds an arbitrary limit
    If iCount > 99 Then
      MsgBox "NOTHING DONE." & vbCrLf & _
             "The New 'Sheet Name' exceeds the ARBITRARY duplicate limitation of 99." & vbCrLf & _
             "New Sheet Name: '" & sDestinationSheetName & "'"
      GoTo MY_EXIT
    End If
      
    'Terminate if the New 'Sheet Name' exceeds the 31 character name limitation
    'NOTE: No checking is done for illegal characters in the name
    If Len(sDestinationSheetName) > 31 Then
      MsgBox "NOTHING DONE." & vbCrLf & _
             "The New 'Sheet Name' exceeds the Excel 31 character limitation." & vbCrLf & _
             "New Sheet Name: '" & sDestinationSheetName & "'" & vbCrLf & _
             "Number of characters: " & Len(sDestinationSheetName)
      GoTo MY_EXIT
    End If
      
    'Terminate if the 'New Sheet Name' contains illegal characters
    bIllegalCharacterInSheetName = DoesSheetNameContainIllegalCharacters(sDestinationSheetName)
    If bIllegalCharacterInSheetName = True Then
      MsgBox "NOTHING DONE." & vbCrLf & _
             "The New 'Sheet Name' has an ILLEGAL Character." & vbCrLf & _
             "Illegal Characters include:  : \ / ? * [ ]" & vbCrLf & _
             "New Sheet Name: '" & sDestinationSheetName & "'"
      GoTo MY_EXIT
    End If
      
    'Exit the Loop if the 'Sheet Name' DOES NOT EXIST
    'It is now OK to create the new Sheet
    If LjmSheetExists(sDestinationSheetName) = False Then
      bNeedMore = False
    End If
  Wend
  
  'Delete all Unauthorized Master Sheet Clones (e.g. 'PEMaster (2) etc) which should not exist
  Application.DisplayAlerts = False         'Inhibit 'Do you really want to delete ... message'
  For Each wks In ThisWorkbook.Worksheets
    sSheetName = wks.Name
    If sSheetName Like "Master (*" Then
      wks.Visible = xlSheetHidden
      wks.Delete
    End If
  Next wks
  Application.DisplayAlerts = True
  
  'Unhide a VeryHidden 'Source Sheet' if Needed
  iSourceSheetOriginalVisibility = ThisWorkbook.Worksheets(sSourceSheetName).Visible
  If iSourceSheetOriginalVisibility = xlSheetVeryHidden Then
    ThisWorkbook.Worksheets(sSourceSheetName).Visible = xlSheetHidden
  End If
    
    
  'Make a copy of the 'Source Sheet' (as the Last Sheet in the Workbook)
  ThisWorkbook.Worksheets(sSourceSheetName).Copy After:=ThisWorkbook.Sheets(Sheets.Count)
    
  'Change the name of the 'New' Sheet
  'Make the new Sheet visible
  sMasterSheetCloneName = sSourceSheetName & " (2)"
  Set wks = Sheets(sMasterSheetCloneName)
  wks.Name = sDestinationSheetName
  wks.Visible = xlSheetVisible
        
  'Hide a VeryHidden 'Sheet2' if it was originally 'Very Hidden'
  If iSourceSheetOriginalVisibility = xlSheetVeryHidden Then
    ThisWorkbook.Worksheets(sSourceSheetName).Visible = xlSheetVeryHidden
  End If
    
    
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'The following lines must be modified each time a new UserForm is added
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'If the request came from the 'ListBox', then update the ListBox contents
  If sSourceOfRequest = "From UserForm1" Then
    Call PopulateUserForm1ListBox1
  ElseIf sSourceOfRequest = "From UserForm2" Then
    Call PopulateUserForm2ListBox1
  End If
  
  'Turn on Screen Updating
  Application.ScreenUpdating = True
  
  MsgBox "New Sheet SUCCESSFULLY created." & vbCrLf & _
         "New Sheet Name: '" & sDestinationSheetName & "'"
         
                    
MY_EXIT:
  'Turn on Screen Updating
  Application.ScreenUpdating = True
  
  'Put the Focus on 'Sheet1'
  Sheets("Sheet1").Select
  
  'Clear object pointer
  Set wks = Nothing
  
End Sub

Sub PopulateUserForm0ListBox1()
  'This clears the UserForm 'ListBox', and then populates the 'ListBox'
  'with all Sheet Names that contain an Underscore

  Dim ws As Worksheet
  Dim sSheetName As String
  
  'Clear the contents of the ListBox
  UserForm0.ListBox1.Clear
  
  'Populate the ListBox
  For Each ws In ThisWorkbook.Worksheets
    sSheetName = ws.Name
  
    If sSheetName Like "*_*" Then
      UserForm0.ListBox1.AddItem sSheetName
    End If
  Next ws

End Sub

Sub PopulateUserForm1ListBox1()
  'This clears the UserForm 'ListBox', and then populates the 'ListBox'
  'with all Sheet Names that contain an Underscore

  Dim ws As Worksheet
  Dim sSheetName As String
  
  'Clear the contents of the ListBox
  UserForm1.ListBox1.Clear
  
  'Populate the ListBox
  For Each ws In ThisWorkbook.Worksheets
    sSheetName = ws.Name
  
    If sSheetName Like "*_*" Then
      UserForm1.ListBox1.AddItem sSheetName
    End If
  Next ws

End Sub

Sub PopulateUserForm2ListBox1()
  'This clears the UserForm 'ListBox', and then populates the 'ListBox'
  'with all Sheet Names that contain an Underscore

  Dim ws As Worksheet
  Dim sSheetName As String
  
  'Clear the contents of the ListBox
  UserForm2.ListBox1.Clear
  
  'Populate the ListBox
  For Each ws In ThisWorkbook.Worksheets
    sSheetName = ws.Name
  
    If sSheetName Like "*_*" Then
      UserForm2.ListBox1.AddItem sSheetName
    End If
  Next ws

End Sub

Lewis

Lewis,
Truly, thanks for the speed of response. Its truly amazing to me. I am just now looking at what you sent but from a quick glance (and correct me if I am wrong), it seems I will need a userform for each rectangle I have, right?
The thing is I have about 55 of these and now I am worried about the volume of code (for easy management) as well as the size of the final file

I am thinking I would like to stick to just one rectangle, but instead of just reading from cell "AF21", the user is given a range to select a name from "AF21 to AF71"

So Basically after selecting the form we want to generate from the Userform, we include an step that gives the user a range (AF21:AF71) to select the port name they want

I think this will be easier &cleaner than having 55 userforms. I'll use just one rectangle and create all the sheets Needed.

I'll give the above solution a whirl in the meantime! you are a God-sent and sorry for all changes

Harry

Harry,

Since you have 55 different sets of values, my approach with multiple UserForms is not optimum.

I don't completely understand your data structure, but the best way to approach the problem is probably:
a. User Selects either one of 55 items from a list in a UserForm (or from a ListBox or ComboBox on the Spreadsheet) or atttempts to move to cell AF21 thru AF71.
b. UserForm automatically puts up the choices associated with that cell, or Rectangles in the SpreadSheet change the text in them to reflect the choices associated with that cell.

In order to implement this, I would need to see a sample workbook, with 2 or 3 items from column 'AF' and the associated choices that go with those items. I would need to know what has to be done when each rectangle (or rectangle equivalent in a UserForm) is selected, if it is different from what you don in AF21.

Lewis,
Thanks Again. Your OPTION A is pretty much what is needed. And to further Illustrate I have attached 2 graphics below...The First Illustrates how the code works now (Which is perfect) in Steps 1,2 and 3 (in RED CIRCLES).

The Second Illustrates the small Modification required (perhaps using a useform + list box)

------See below (Current Process) -------
SampleWorkProcess_new form pg 1.jpg






------------(Modified Process) ----------
SampleWorkProcess_new form pg 2.jpg



Hope this helps )

Hi Harry,

The attached file (based on version 3 [post #4], not version 4 [post #8]) should take care of what you want. The design changes were minimal. I added a Forms ComboBox (Drop Down) to the spreadsheet, and added a ComboBox to the UserForm. Both used AF21 thru AF71 to obtain the possible values.

In the spreadsheet, the Forms ComboBox formatting is elementary at best. An 'Active X' ComboBox could be used in the spreadsheet instead to make the formatting more robust, however, 'Active X' controls tend to be unstable and can cause problems which appear to be file corruptions. My personal preference is to not use a ComboBox on the spreadsheet, and to use the UserForm exclusively.

To implement the code in your file:
a. Export the 2 ordinary code modules and the 1 UserForm module from my file.
b. Import module ModCloneSheet2 if it doesn't exist (no changes made).
c. Replace module ModFormSheetGeneration (e.g. Remove, then Import).
d. Replace the UserForm1 module.
e. Cut and paste the ThisWorkbook module code into your file if it doesn't already exist.
f. Cut and past the Sheet1 module code if the code from your initial request (Post #1) is needed.


Major code changes are highlighted below in red, so you can see what was done.

UserForm1 code module excerpts:

Private Sub UserForm_Initialize()
 
 'Some existing code deleted

  'Put the items in cells AF21 thru AF71 in the 'ComboBox
  Call PopulateUserForm1ComboBox1
  
  'Put all Sheet Names containing UnderScores in the 'ListBox'
  Call PopulateUserForm1ListBox1
  
  'Display or Hide Controls as required based on the ComboBox value
  Call ComboBox1_Change
  
End Sub

Private Sub ComboBox1_Change()

  Dim i As Long
  Dim bHaveMatch As Boolean
  Dim bVisible As Boolean
  Dim sValue As String
  
  'Get the ComboBox value (no leading or trailing spaces)
  sValue = Trim(ComboBox1.Value)
  
  'Make the selections     visible if the value is NOT BLANK
  'Make the selections NOT visible if the value is  BLANK
  If Len(sValue) = 0 Then
    bVisible = False
  Else
    bVisible = True
    
    'Determine if the value is VALID
    For i = 0 To ComboBox1.ListCount - 1
      If sValue = ComboBox1.List(i) Then
        bHaveMatch = True
        Exit For
      End If
      'Debug.Print ComboBox1.List(i)
    Next i
    
    If bHaveMatch = False Then
      MsgBox "Illegal Value in ComboBox." & vbCrLf & _
             "Preset Values ONLY are allowed."
      ComboBox1.ListIndex = -1
    End If
  End If
  

  'Display or Hide Controls as required
  Label2.Visible = bVisible
  CommandButton1.Visible = bVisible
  CommandButton2.Visible = bVisible
  CommandButton3.Visible = bVisible
  CommandButton4.Visible = bVisible
  CommandButton5.Visible = bVisible
  CommandButton6.Visible = bVisible
  

End Sub

Ordinary code module ModFormSheetGeneration excerpts:

Option Explicit

Public Const sItemSelectionRANGE = "AF21:AF71"

Sub CreateCloneSheet(sSheetDescription As String, Optional sSourceOfRequest As String)

  Dim wks As Worksheet

  Dim iCount As Long
  Dim iReply As Long
  Dim iSourceSheetOriginalVisibility As Long       'This must be a type 'long' and not a type 'boolean'

  Dim bIllegalCharacterInSheetName As Boolean
  Dim bNeedMore As Boolean

  Dim sBaseNewSheetName As String
  Dim sDestinationSheetName As String
  Dim sDestinationSheetPreambleName As String
  Dim sDestinationSheetDescription As String
  Dim sMasterSheetCloneName As String
  Dim sSheetName As String
  Dim sSourceSheetName As String
  Dim sValueFromAF21 As String

  
  'Get the value from ComboBox (either UserForm ComboBox or Spreadsheet ComboBox)
  'Remove leading and trailing spaces
  If sSourceOfRequest = "From UserForm" Then
    sValueFromAF21 = UserForm1.ComboBox1.Value
  Else
    sValueFromAF21 = GetFormsComboBoxValue()
  End If
  
  sValueFromAF21 = Trim(sValueFromAF21)
  If Len(sValueFromAF21) = 0 Then
    MsgBox "NOTHING DONE." & vbCrLf & _
           "The ComboBox value MUST NOT be BLANK."
    GoTo MY_EXIT
  End If
  
  'Remainder of code is unchanged
    
End Sub

Sub PopulateUserForm1ComboBox1()
  'This clears the UserForm 'ComboBox', and then populates the 'ComboBox'
  'with the non-blank items from cells AF21 thru AF71

  Dim myRange As Range
  Dim r As Range
  
  Dim iComboBoxRow As Long
  
  Dim sAddress As String
  Dim sValue As String
  
  'Clear the contents of the ComboBox
  UserForm1.ComboBox1.Clear
  
  'Create the Range
  Set myRange = ActiveSheet.Range(sItemSelectionRANGE)
 
  'Initialize the ComboBox Row
  iComboBoxRow = -1
 
  'Populate the ComboBox
  For Each r In myRange
    sAddress = r.Address(False, False)
    sValue = Trim(r.Value)
  
    If Len(sValue) > 0 Then
      iComboBoxRow = iComboBoxRow + 1
      UserForm1.ComboBox1.AddItem sValue
      UserForm1.ComboBox1.List(iComboBoxRow, 0) = sValue
      UserForm1.ComboBox1.List(iComboBoxRow, 1) = "---"
      UserForm1.ComboBox1.List(iComboBoxRow, 2) = sAddress
    End If
  Next r
  
  'Clear object pointers
  Set myRange = Nothing
  
End Sub

Function GetFormsComboBoxValue() As String
  'This returns the value in a Forms ComboBox named 'Drop Down 1'

  Dim myComboBox As Object
  Dim myRange As Range
  Dim r As Range
  
  Dim iColumn As Long
  Dim iComboBoxIndex As Long
  Dim iRow As Long
  
  Dim sAddress As String
  Dim sListFillRange As String
  Dim sValue As String
  
  'Create the ComboBox object
  Set myComboBox = ActiveSheet.Shapes("Drop Down 1")
  
  'Get the Index number of the value in the ComboBox
  iComboBoxIndex = myComboBox.ControlFormat.Value
  
  'Get the ComboBox List Fill Range
  sListFillRange = myComboBox.ControlFormat.ListFillRange
  
  'Create the Range
  'Get the Row and Column for the first cell in the range
  Set myRange = ActiveSheet.Range(sListFillRange)
  iRow = myRange.Row
  iColumn = myRange.Column
  
  iRow = iRow + iComboBoxIndex - 1
  
  sValue = ActiveSheet.Cells(iRow, iColumn).Value
  
  'Return the Value to the Calling Routine
  GetFormsComboBoxValue = sValue
  
  'Clear object pointers
  Set myComboBox = Nothing
  Set myRange = Nothing

End Function

Lewis

It works BEAUTIFULLY!!!!! Omg Thanks....I cannot thank you enough for your help!!!!