Hi all,

I have already wrote a vba routine for custom menu. It reads the level of
menu ranking level: 1, 2, 3 from my worksheet called MenuSheet. My MenuSheet
has 5 columns, namely Level, Caption, Macro, Divider and FaceID. I m trying
to add a submenu to a submenu and not sure the walkaround. Can someone throw
me some light. Thanks.

Code as follows:

Sub CreateMenu()

Dim MenuSheet As Worksheet
Dim MenuObject As CommandBarPopup

Dim MenuItem As Object
'Dim MenuItem As CommandBarButton
Dim SubMenuItem As CommandBarButton
'Dim NextSubMenuItem As CommandBarButton
Dim Row As Integer
Dim MenuLevel, NextLevel, PositionOrMacro, Caption, Divider, FaceId

'''''''''''''''''''''''''''''''''''''''''''''''''' ''
' Location for menu data
Set MenuSheet = ThisWorkbook.Sheets("MenuSheet")
'''''''''''''''''''''''''''''''''''''''''''''''''' ''

' Make sure the menus aren't duplicated
Call DeleteMenu

' Initialize the row counter
Row = 2

' Add the menus, menu items and submenu items using
' data stored on MenuSheet

Do Until IsEmpty(MenuSheet.Cells(Row, 1))
With MenuSheet
MenuLevel = .Cells(Row, 1)
Caption = .Cells(Row, 2)
PositionOrMacro = .Cells(Row, 3)
Divider = .Cells(Row, 4)
FaceId = .Cells(Row, 5)
NextLevel = .Cells(Row + 1, 1)
End With

Select Case MenuLevel
Case 1 ' A Menu
' Add the top-level menu to the Worksheet CommandBar
Set MenuObject = Application.CommandBars(1). _
Controls.Add(Type:=msoControlPopup, _
Befo=PositionOrMacro, _
Temporary:=True)
MenuObject.Caption = Caption

Case 2 ' A Menu Item
If NextLevel = 3 Then
Set MenuItem =
MenuObject.Controls.Add(Type:=msoControlPopup)
Else
Set MenuItem =
MenuObject.Controls.Add(Type:=msoControlButton)
MenuItem.OnAction = PositionOrMacro
End If
MenuItem.Caption = Caption
If FaceId < "" Then MenuItem.FaceId = FaceId
If Divider Then MenuItem.BeginGroup = True

Case 3 ' A SubMenu Item
Set SubMenuItem =
MenuItem.Controls.Add(Type:=msoControlButton)
SubMenuItem.Caption = Caption
SubMenuItem.OnAction = PositionOrMacro
If FaceId < "" Then SubMenuItem.FaceId = FaceId
If Divider Then SubMenuItem.BeginGroup = True

End Select
Row = Row + 1
Loop
End Sub