Create a Quick Custom Format Tab on Mouse Right Click

Create a new menu "Quick Custom Format Tab" on mouse right click for quickly applying the custom formatting on your workbook. Snapshot below -

All you have to do is download the workbook 

Download Link - https://www.box.com/s/67nq6zg97mqpck5h5ux7

Keep adding the new custom formats which you use on daily basis on the worksheet "Custom_Formats" . 

Note Make sure text in column D is unique .

You can also move these worksheet to your own workbook and use them . Don't forget to move the VBA modules as well 

Udf's Used -

Function no_like(cl As Range)

no_like = "' " & cl.Text

End Function

Function know_cutsomformat(cl As Range)

know_cutsomformat = cl.NumberFormat

End Function

Workbook Module code- 

Private Sub Workbook_Open()

    On Error Resume Next

    Application.CommandBars("Cell").Controls("Quick Custom Format Tab").Delete

    Call add_custom_menu

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    On Error Resume Next

    Application.CommandBars("Cell").Controls("Quick Custom Format Tab").Delete

End Sub

Paste below code in module 1 or any new module

Option Explicit

Sub add_custom_menu()

    

    Dim cBut        As CommandBarControl

    On Error Resume Next

    Application.CommandBars("Cell").Controls("Quick Custom Format Tab").Delete

    Set cBut = Application.CommandBars("Cell").Controls.Add(Type:=msoControlPopup, Temporary:=True)

    cBut.Caption = "Quick Custom Format Tab"

    cBut.OnAction = "new_button_macro"

    

End Sub

Sub new_button_macro()

Dim wk As Workbook

Dim wks As Worksheet

Dim cmda As CommandBarControl

Dim cbut2 As CommandBarControl, CBT3 As CommandBarControl

Dim i As Long, j As Long

    For Each cmda In Application.CommandBars("Cell").Controls("Quick Custom Format Tab").Controls

        On Error Resume Next

        cmda.Delete

    Next

    

    For i = 2 To ThisWorkbook.Sheets("Custom_Formats").Range("a65356").End(xlUp).Row

        Set cbut2 = Application.CommandBars("Cell").Controls("Quick Custom Format Tab").Controls.Add(Type:=msoControlPopup)

        With cbut2

            .Caption = ThisWorkbook.Sheets("Custom_Formats").Range("a" & i).Value

            .BeginGroup = True

        End With

        For j = i To i - 1 + Application.WorksheetFunction.CountIf(ThisWorkbook.Sheets("Custom_Formats").Columns("a:a"), ThisWorkbook.Sheets("Custom_Formats").Range("a" & i).Value)

            Set CBT3 = cbut2.Controls.Add(Type:=msoControlButton)

            With CBT3

                .Caption = ThisWorkbook.Sheets("Custom_Formats").Range("d" & j).Value

                .OnAction = "format"

                .BeginGroup = False

                .FaceId = 351

            End With

        Next

       i = j - 1

    Next

End Sub

Sub format()

Dim i As Long

If Application.WorksheetFunction.CountIf(ThisWorkbook.Sheets("Custom_Formats").Columns("d:d"), Application.CommandBars.ActionControl.Caption) > 0 Then

    i = Application.WorksheetFunction.Match(Application.CommandBars.ActionControl.Caption, ThisWorkbook.Sheets("Custom_Formats").Columns("d:d"), 0)

    Selection.NumberFormat = ThisWorkbook.Sheets("Custom_Formats").Range("c" & i).Value

Else

    MsgBox "Custom format not available"

End If

End Sub

Download working workbook here  https://www.box.com/s/67nq6zg97mqpck5h5ux7