adding a new sheet to master and dependent files

[ajm]

hi all,

I have a dogs breakfast of a piece of code that you have all helped me write over time and i need some further tweaks. the purpose of the code is to add new outlets to our sales departments Promotional Planner. The planner is split with a Master copy and then several individual account manager copies.

I need to be able to be able to have the Key Account Manager create new outlets in the Master file, and then depending upon the account managers name, go to that file and insert the new outlet sheet. Each file is set up exactly the same with the Outlet sheets between "First" and "Last". Now, I can get the new sheet over into the relevant account managers file, but I can't get the sheets to sort as they do in the master. even tried a before close event in the destination workbook but it wouldn't fire for some reason.

anyway, here is the code so far. I hope its clear enough to follow:

Private Sub CommandButton1_Click()

    Application.Calculation = xlCalculationAutomatic
    CreateObject("WScript.Shell").CurrentDirectory = ThisWorkbook.Path
    Dim UpdateFileName As Variant
    Dim AddSheetQuestion As Variant
    Dim pw As Variant
    Dim KAM As Variant
    Dim LatestSheet As Variant
    Dim UpdateKAMsFile As String


    Application.ScreenUpdating = False

    '   Use this code to suppress "sheet deletion" warning
    Application.DisplayAlerts = False

    'NEED MSG BOX TO ASK IF USER INTENDS TO ADD NEW GROUP

    If MsgBox("Do you wish to add a new Outlet Group?", vbYesNo, "NEW OUTLET") = vbNo Then Exit Sub

    'input password
    pw = InputBox("Enter password:", "Password Required")
    If pw <> "password" Then
        MsgBox "The password you entered is incorrect"
        End
    End If


    'Define the application input box question
showAddSheetQuestion:
    AddSheetQuestion = Application.InputBox("Please Enter New Outlet Group Name:", "Add new Outlet Group")

    'Cancel or the X was clicked
    If AddSheetQuestion = False Then
        MsgBox "You clicked the Cancel button." & vbCrLf & _
               "No new sheet will be added.", 64, "Cancel was clicked."
        Exit Sub

        'OK was clicked without anything being entered
    ElseIf AddSheetQuestion = "" Then
        MsgBox "You clicked OK but entered nothing." & vbCrLf & vbCrLf & _
               "Please type in a valid sheet name." & vbCrLf & _
               "Otherwise, you must click Cancel to exit." & vbCrLf & vbCrLf & _
               "Click OK and let's try again.", 48, "Hmmm...that didn't make sense..."
        GoTo showAddSheetQuestion

    End If

    'See if a worksheet exists that is named as the new name being attempted to add.
    If SheetExists(CStr(AddSheetQuestion)) Then
        MsgBox "A worksheet already exists that is named " & AddSheetQuestion & "." _
             & vbCrLf & vbCrLf & _
               "Please click OK, verify the name you really" & vbCrLf & _
               "want to add, and try again." & vbCrLf & vbCrLf & "Sheet addition cancelled.", _
               48, "Sorry, that name already taken."
        GoTo showAddSheetQuestion
    End If

    'Here's the actual sheet addition code
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With

    'copy and paste Group Template
    Sheets("Group Template").Visible = xlSheetVisible
    Sheets("Last").Visible = xlSheetVisible
    Worksheets("Group Template").Copy before:=Worksheets("Last")
    With ActiveSheet
        'force input Outlet Group Name into Proper Case and then remove spaces
        .Name = Replace(StrConv(AddSheetQuestion, vbProperCase), " ", "")
        .Range("b2").Value = .Range("b2").Value
    End With

    'identify latest sheet added for later use
    LatestSheet = ActiveSheet.Name

    'name Key Account Manager
    KAM = InputBox("Enter Key Account Manager's Name:", "Name Required")
    Application.Goto Reference:="NameAccountManager"
    With ActiveCell
        .Value = Replace(StrConv(KAM, vbProperCase), " ", " ")
    End With

    'to re hide it
    Sheets("Group Template").Visible = xlVeryHidden
    Sheets("Last").Visible = xlVeryHidden

    ' order Outlet Tabs alphabetically before closing

    startt = Sheets("First").Index + 1
    endd = Sheets("Last").Index - 1
    For i = startt To endd - 1
        For j = i + 1 To endd
            If Sheets(j).Name < Sheets(i).Name Then
                Sheets(j).Move before:=Sheets(i)
            End If
        Next j
    Next i

    'add new group to Opportunity Martrix

    Worksheets("Opportunity Matrix").Activate
    ActiveSheet.Unprotect ("password")
    Application.Goto Reference:="NewGroupNameCell"
    With ActiveCell
        .Value = AddSheetQuestion
        .Value = Replace(StrConv(AddSheetQuestion, vbProperCase), " ", "")
    End With
    Application.Goto Reference:="NewGroupLineFormat"
    Selection.Copy
    Application.Goto Reference:="NewGroupLine"
    Selection.Insert Shift:=xlDown
    Application.Goto Reference:=ActiveSheet.UsedRange
    ActiveSheet.Protect ("password")

    'add new group to Opportunity Martrix2
    Worksheets("Opportunity Matrix (2)").Activate
    ActiveSheet.Unprotect ("password")
    Application.Goto Reference:="NewRangeOutletNameCell"
    With ActiveCell
        .Value = AddSheetQuestion
        .Value = Replace(StrConv(AddSheetQuestion, vbProperCase), " ", "")
    End With
    Application.Goto Reference:="NewRangeFormat"
    Selection.Copy
    Application.Goto Reference:="NewRangeInsertLine"
    Selection.Insert Shift:=xlDown
    Application.Goto Reference:=ActiveSheet.UsedRange
    ActiveSheet.Protect ("password")

    'add new group to particular KAM's workbook

    UpdateKAMsFile = "Promo Plan F08 - " & KAM

    With Workbooks.Open(UpdateKAMsFile)
        .Sheets("Last").Visible = xlSheetVisible
        ThisWorkbook.Sheets(LatestSheet).Copy before:=Worksheets("Last")
        .Sheets("Last").Visible = xlSheetVeryHidden

' order Outlet Tabs alphabetically before closing



    End With











    'Inform the user the macro is completed
    MsgBox "The new Outlet Group ''" & AddSheetQuestion & "'' has been added.", _
           64, "Sheet addition successful."
End Sub
Function SheetExists(strWSName As String) As Boolean
    Dim WS As Worksheet
    On Error Resume Next
    Set WS = Worksheets(strWSName)
    If Not WS Is Nothing Then SheetExists = True
    'Boolean function assumed to be False unless set to True
End Function

any ideas??

 

[ajm]

have since found

' order Outlet Tabs alphabetically before closing

Application.Run ActiveWorkbook & "!OrderSheets"

but can't get the macro to run the order macro (in module 2).

the order sheets macros is

' order Outlet Tabs alphabetically before closing

    startt = Sheets("First").Index + 1
    endd = Sheets("Last").Index - 1
    For i = startt To endd - 1
        For j = i + 1 To endd
            If Sheets(j).Name < Sheets(i).Name Then
                Sheets(j).Move before:=Sheets(i)
            End If
        Next j
    Next i