Oops...I have added the table headers just for your reference....The table
range should be in A1:D15 with no headers.....

Also the starting row needs to be changed from 2 to 1 in code
lngRow = 1

Please try and feedback.....

If this post helps click Yes
---------------
Jacob Skaria


"Jacob Skaria" wrote:

I got a chance to look into this only this morning...OK Shall we try this 5
level...You can add more as your requirement....

The below procedure looks into a table which will have details of the menus
to be build. Currently it is targetted to the ActiveSheet. Please make
necessary changes to that. The table format is as below with Row1 containing
headers Unique menu ID, Menu Caption, Control Type (1 for button and 10 for
popup) and Parent menu id. If parent menu id is 0 that menu will be created
in level 1. The below table range is from A1:D16. Please try and feedback....

UID Caption Ctrl type Parent UID
1 Level1A 1 0
2 Level1B 10 0
3 Level1C 1 0
4 Level2A 1 2
5 Level2B 10 2
6 Level2C 1 2
7 Level3a 1 5
8 Level3b 10 5
9 Level3c 1 5
10 Level4a 1 8
11 Level4b 10 8
12 Level4c 1 8
13 Level5a 1 11
14 Level5b 1 11
15 Level5c 1 11



Sub AddMenus()

Dim lngRow As Long
Dim iHelpMenu As Integer
Dim varMenuType As Variant
Dim intMenuParent As Integer
Dim strMacroName As String
Dim strMainMenu As String
Dim strMenuCaption As String
Dim cbMainMenuBar As CommandBar
Dim cbcCustomMenu As CommandBarControl
Dim arrCustomMenu() As CommandBarControl

lngRow = 2
strMainMenu = "MyMenu"

On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls(strMainMenu).Delete
On Error GoTo 0
Set cbMainMenuBar = Application.CommandBars("Worksheet Menu Bar")
iHelpMenu = cbMainMenuBar.Controls("Help").Index
Set cbcCustomMenu = cbMainMenuBar.Controls.Add(Type:=msoControlPopup,
Befo=iHelpMenu)
cbcCustomMenu.Caption = strMainMenu


Do While ActiveSheet.Range("A" & lngRow) < ""
ReDim Preserve arrCustomMenu(lngRow)
strMenuCaption = Range("B" & lngRow)
varMenuType = Range("C" & lngRow)
intMenuParent = Range("D" & lngRow)
strMacroName = Range("E" & lngRow)

If intMenuParent = 0 Then
Set arrCustomMenu(lngRow) = cbcCustomMenu.Controls.Add(Type:=varMenuType)
arrCustomMenu(lngRow).Caption = strMenuCaption
Else
Set arrCustomMenu(lngRow) =
arrCustomMenu(intMenuParent).Controls.Add(Type:=va rMenuType)
arrCustomMenu(lngRow).Caption = strMenuCaption
arrCustomMenu(lngRow).OnAction = strMacroName
End If

lngRow = lngRow + 1
Loop

End Sub


If this post helps click Yes
---------------
Jacob Skaria