sepecifically this macro has stopped working

Function Macro_Menu()
Dim vbcomp As VBComponent
Dim curMacro As String, newMacro As String
Dim i As Integer
Dim Menu As CommandBarPopup
Dim MenuItem As Object
Dim SubMenuItem As CommandBarButton
Dim FirstExists As Boolean

On Error Resume Next

Application.CommandBars(1).Controls("Macros").Dele te
Set Menu = Application.CommandBars(1).Controls.Add(Type:=msoC ontrolPopup, _
Befo=10, Temporary:=True)
Menu.Caption = "Macros"

curMacro = ""

For Each vbcomp In ThisWorkbook.VBProject.VBComponents

If Right(vbcomp.Name, 7) < "No_Menu" Then
If vbcomp.CodeModule.CountOfLines 4 Then
If vbcomp.DesignerID < "Forms.Form" Then

FirstExists = False
For i = 1 To vbcomp.CodeModule.CountOfLines
issuea = Right(vbcomp.CodeModule.Lines(i, 1), 7)
newMacro = vbcomp.CodeModule.ProcOfLine(i, vbext_pk_Proc)

If curMacro < newMacro Then
curMacro = newMacro
If curMacro < "" Then
If issuea < "No Menu" Then
If Not FirstExists Then
Set MenuItem = Menu.Controls.Add(Type:=msoControlPopup)
MenuItem.Caption = vbcomp.Name
FirstExists = True
End If
Set SubMenuItem = MenuItem.Controls.Add(Type:=msoControlButton)
SubMenuItem.Caption = newMacro
SubMenuItem.OnAction = vbcomp.Name & "." & newMacro
End If
End If
End If
Next
End If
End If
End If
Next

Exit_CWBM:
Exit Function
Err_CWBM:
On Error Resume Next
Resume Exit_CWBM

End Function