Can I shorten This

[Erays]

Sub BuildEdsMenuItem()
Dim newCtrl As CommandBarControl
Set newCtrl = Application.CommandBars("Worksheet Menu Bar") _
    .Controls("Tools").Controls.Add
    newCtrl.Caption = "Create Rei Folders"
    newCtrl.OnAction = "MakeEdsFolder"
    BuildEdsMenuItem1
End Sub

Sub BuildEdsMenuItem1()
Dim newCtrl As CommandBarControl
Set newCtrl = Application.CommandBars("Worksheet Menu Bar") _
    .Controls("Tools").Controls.Add
    newCtrl.Caption = "Initial Email and Save"
    newCtrl.OnAction = "EmailRei"
BuildEdsMenuItem2
End Sub

Sub BuildEdsMenuItem2()
Dim newCtrl As CommandBarControl
Set newCtrl = Application.CommandBars("Worksheet Menu Bar") _
    .Controls("Tools").Controls.Add
    newCtrl.Caption = "Supplement Email and Save"
    newCtrl.OnAction = "EmailSupp"
    BuildEdsMenuItem3
End Sub

Sub BuildEdsMenuItem3()
Dim newCtrl As CommandBarControl
Set newCtrl = Application.CommandBars("Worksheet Menu Bar") _
    .Controls("Tools").Controls.Add
    newCtrl.Caption = "TotalLoss Email and Save"
    newCtrl.OnAction = "EmailTLA"
BuildEdsMenuItem4
End Sub

Sub BuildEdsMenuItem4()
Dim newCtrl As CommandBarControl
Set newCtrl = Application.CommandBars("Worksheet Menu Bar") _
    .Controls("Tools").Controls.Add
    newCtrl.Caption = "Save Initial Rei"
    newCtrl.OnAction = "SaveRei"
BuildEdsMenuItem5
End Sub

Sub BuildEdsMenuItem5()
Dim newCtrl As CommandBarControl
Set newCtrl = Application.CommandBars("Worksheet Menu Bar") _
    .Controls("Tools").Controls.Add
    newCtrl.Caption = "Save Supplement Rei"
    newCtrl.OnAction = "SaveSupp"
    BuildEdsMenuItem6
End Sub

Sub BuildEdsMenuItem6()
Dim newCtrl As CommandBarControl
Set newCtrl = Application.CommandBars("Worksheet Menu Bar") _
    .Controls("Tools").Controls.Add
    newCtrl.Caption = "Save Total Loss Rei"
    newCtrl.OnAction = "SaveTotal"
End Sub

Sub DeleteEdsMenuItem()
Dim ctrl As CommandBarControl
For Each ctrl In Application.CommandBars("Worksheet Menu Bar") _
        .Controls("Tools").Controls
If ctrl.Caption = "Create Rei Folders" Then ctrl.Delete
Next
    DeleteEdsMenuItem1
End Sub

Sub DeleteEdsMenuItem1()
Dim ctrl As CommandBarControl
For Each ctrl In Application.CommandBars("Worksheet Menu Bar") _
        .Controls("Tools").Controls
If ctrl.Caption = "Initial Email and Save" Then ctrl.Delete
Next
    DeleteEdsMenuItem2
End Sub

Sub DeleteEdsMenuItem2()
Dim ctrl As CommandBarControl
For Each ctrl In Application.CommandBars("Worksheet Menu Bar") _
        .Controls("Tools").Controls
If ctrl.Caption = "Supplement Email and Save" Then ctrl.Delete
Next
    DeleteEdsMenuItem3
End Sub

Sub DeleteEdsMenuItem3()
Dim ctrl As CommandBarControl
For Each ctrl In Application.CommandBars("Worksheet Menu Bar") _
        .Controls("Tools").Controls
If ctrl.Caption = "TotalLoss Email and Save" Then ctrl.Delete
Next
    DeleteEdsMenuItem4
End Sub

Sub DeleteEdsMenuItem4()
Dim ctrl As CommandBarControl
For Each ctrl In Application.CommandBars("Worksheet Menu Bar") _
        .Controls("Tools").Controls
If ctrl.Caption = "Save Initial Rei" Then ctrl.Delete
Next
    DeleteEdsMenuItem5
End Sub

Sub DeleteEdsMenuItem5()
Dim ctrl As CommandBarControl
For Each ctrl In Application.CommandBars("Worksheet Menu Bar") _
        .Controls("Tools").Controls
If ctrl.Caption = "Save Supplement Rei" Then ctrl.Delete
Next
    DeleteEdsMenuItem6
End Sub

Sub DeleteEdsMenuItem6()
Dim ctrl As CommandBarControl
For Each ctrl In Application.CommandBars("Worksheet Menu Bar") _
        .Controls("Tools").Controls
If ctrl.Caption = "Save Total Loss Rei" Then ctrl.Delete
Next
End Sub

[Jacob Hilderbrand]

You can reduce the number of Subs and just call the same Sub with different Arguments.

Option Explicit
 
Sub BuildMenuItems()
Call BuildEdsMenuItem("Create Rei Folders", "MakeEdsFolder")
    Call BuildEdsMenuItem("Initial Email and Save", "EmailRei")
    Call BuildEdsMenuItem("Supplement Email and Save", "EmailSupp")
    Call BuildEdsMenuItem("TotalLoss Email and Save", "EmailTLA")
...
...
...
End Sub
 
Sub BuildEdsMenuItem(Cap As String, OnAct As String)
Dim newCtrl As CommandBarControl
Set newCtrl = Application.CommandBars("Worksheet Menu Bar") _
    .Controls("Tools").Controls.Add
    newCtrl.Caption = "Create Rei Folders"
    newCtrl.OnAction = "MakeEdsFolder"
End Sub

[MOS MASTER]

Hi,

I was already working on this but DRJ beat me to it! this is about the same as he suggested.

I have choosen to build a complete new menu instead off altering the Tools button...

the code

Sub MakeMenu()
Dim newMenu As CommandBarPopup
On Error Resume Next
DeleteMyButton
Set newMenu = Application.CommandBars("Worksheet Menu Bar") _
.Controls.Add(Type:=msoControlPopup, Before:=7)
With newMenu
.Caption = "My Tools"
.Visible = True
End With
AddMyButton newMenu, "Create Rei Folders", "MakeEdsFolder"
AddMyButton newMenu, "Initial Email and Save", "EmailRei"
AddMyButton newMenu, "Supplement Email and Save", "EmailSupp"
AddMyButton newMenu, "TotalLoss Email and Save", "EmailTLA"
AddMyButton newMenu, "Save Initial Rei", "SaveRei"
AddMyButton newMenu, "Save Supplement Rei", "SaveSupp"
AddMyButton newMenu, "Save Total Loss Rei", "SaveTotal"
Set newMenu = Nothing
End Sub
 
Sub AddMyButton(myMenu As CommandBarPopup, sCaption As String, sAction As String)
With myMenu.Controls.Add(Type:=msoControlButton)
.Caption = sCaption
.OnAction = sAction
End With
End Sub
 
Sub DeleteMyButton()
Dim ctrl As CommandBarPopup
For Each ctrl In Application.CommandBars("Worksheet Menu Bar").Controls
If ctrl.Caption = "My Tools" Then ctrl.Delete
Next
End Sub

Enjoy!

[mvidas]

Well, I also made one, little bit different. I assumed you ran your Delete subs first, then the add subs, I just combined it so it deletes it before it adds it:

Sub BuildEdsMenuItem()
 EdsMenu "Create Rei Folders", "MakeEdsFolder"
 EdsMenu "Initial Email and Save", "EmailRei"
 EdsMenu "Supplement Email and Save", "EmailSupp"
 EdsMenu "TotalLoss Email and Save", "EmailTLA"
 EdsMenu "Save Initial Rei", "SaveRei"
 EdsMenu "Save Supplement Rei", "SaveSupp"
 EdsMenu "Save Total Loss Rei", "SaveTotal"
End Sub

Public Function EdsMenu(vCaption As String, vOnAction As String)
 Dim ctrl As CommandBarControl
 On Error Resume Next
 Application.CommandBars("Tools").Controls(vCaption).Delete
 On Error GoTo 0
 With Application.CommandBars("Worksheet Menu Bar").Controls("Tools").Controls.Add
  .Caption = vCaption
  .OnAction = vOnAction
 End With
End Function

Matt

[MOS MASTER]

Hi Matt,

Seams like always in VBA there are many ways to reach Rome!

[Erays]

M.O.S. Master
has done it this is a great way to create a new menu in excel works really great

Thanks to M.O.S. Master

[MOS MASTER]

You're Welcome Erays...

Have fun creating you're Menu's and amaze you're collegue's with you're work!

To make you're buttons look nicer add pictures to them with the:

.FaceId = 100
.Style = msoButtonIconAndCaption
properties..

Then you're function would look like:

Sub AddMyButton(myMenu As CommandBarPopup, _
sCaption As String, sAction As String, iID As Integer)
With myMenu.Controls.Add(Type:=msoControlButton)
.Caption = sCaption
.OnAction = sAction
.FaceId = iID
.Style = msoButtonIconAndCaption
End With
End Sub

'To call change to:

AddMyButton newMenu, "Save Total Loss Rei", "SaveTotal", 107

Just play with it!

[Zack Barresse]

.. Thanks to M.O.S. Master ..

Ahem, and to mvidas and DRJ as well - they helped just as much as MOS Master has. And it's great to be appreciated, but even worse to not be appreciated at all!

[MOS MASTER]

And it's great to be appreciated, but even worse to not be appreciated at all!

True...no appreciation what so ever can get a brother down...

[Erays]

Thanks to all who have helped me (DRJ, mvidas, MOS Master, Firefytr) I look forward to the day that I myself can help someone with this.

I say to others I dont have my foot in the door But I do have my little toenail there!