Sub CreateItemsInCellContextMenu()
    On Error Resume Next
    PopularBrowsers = Array("Internet Explorer", "Mozilla Firefox", "Opera", "Google Chrome")

    Application.CommandBars("cell").Reset    ' сброс контекстного меню ячеек
   Application.CommandBars("cell").Controls(1).BeginGroup = True    ' черточка над первым пунктом меню

    ' добавляем пункты в контекстное меню ячеек
   With Application.CommandBars("cell").Controls.Add(10, , , 1)
        .Caption = "Искать через другой браузер ..."

        ' добавляем подпункты в меню
       For Each browser In PopularBrowsers    ' для каждого браузера - свой подпункт меню
           With .Controls.Add(1, , , 1)    ' добавляем пункт меню
               .OnAction = "SearchValuesInWeb"    ' назначаем кнопке макрос SearchValuesInWeb
               .Caption = browser: .Tag = browser    ' в свойстве TAG запоминаем название браузера
           End With
        Next
    End With

    ' отдельный пункт - для поиска в браузере, установленном в системе по-умолчанию
   With Application.CommandBars("cell").Controls.Add(1, , , 1)
        .OnAction = "SearchValuesInWeb"    ' назначаем кнопке макрос SearchValuesInWeb
       .Caption = "Искать в Google в браузере по-умолчанию"
    End With
End Sub

Sub SearchValuesInWeb()
    ' Макрос открывает в выбранном браузере результаты поиска значений из ячеек
   ' поиск производится в Google

    On Error Resume Next: Err.Clear
    browser$ = Application.CommandBars.ActionControl.Tag    ' читаем параметр из свойства TAG
   If Err Then Exit Sub    ' запуск не из контекстного меню

    maxCellsCount = 20    ' больше 20 ячеек - отказываемся от запуска поиска

    Dim coll As New Collection
    ' берем только непустые уникальные значения из выделенного диапазона ячеек
   Dim ra As Range: Set ra = Intersect(Selection, ActiveSheet.UsedRange)
    arr = ra.Value: If ra.Cells.Count = 1 Then arr = Array(ra(1))
    For Each Item In arr
        If Len(Trim(Item)) Then coll.Add CStr(Trim(Item)), CStr(Trim(Item))
        If coll.Count > maxCellsCount Then Exit For
    Next

    ' если случайно запустить поиск тысячи значений - комп подвиснет надолго...
   If coll.Count > maxCellsCount Then
        msg = "Количество значений для поиска провысило ограничение в " & maxCellsCount & " ячеек!"
        MsgBox msg, vbExclamation, "Слишком много значений - поиск отменяется"
        Exit Sub
    End If

    ' формируем путь к выбранному браузеру (в реестре нужную информацию выкопать сложно...)
   ' не факт, что быдет работать на всех компах (программы могли быть установлены в другие папки)
   Select Case browser$    ' "Internet Explorer", "Mozilla Firefox", "Opera", "Google Chrome"
       Case "Internet Explorer"
            Path$ = """" & Environ("ProgramFiles") & "\Internet Explorer\IEXPLORE.EXE" & """"
        Case "Mozilla Firefox"
            Path$ = """" & Environ("ProgramFiles") & "\Mozilla Firefox\firefox.exe" & """ -new-tab "
        Case "Opera"
            Path$ = """" & Environ("ProgramFiles") & "\Opera\opera.exe" & """"
        Case "Google Chrome"
            Path$ = """" & Environ("USERPROFILE") & "\Local Settings\Application Data\" _
                    & "Google\Chrome\Application\chrome.exe" & """"
    End Select

    ' проверяем существование исполняемого файла браузера
   Path2$ = Path$: If Dir(Split(Path$, Chr(34))(1), vbNormal) = "" Then Path2$ = ""

    For Each Item In coll    ' перебираем все уникальные значения ячеек
       ' формируем поисковую ссылку для Google
       n = n + 1: link$ = """" & "http://www.google.ru/search?hl=ru&newwindow=1&q=" & Item & """"

        If browser$ = "" Then    ' открываем ссылку в браузере "по-умолчанию"
           CreateObject("wscript.shell").Run link$

        Else    ' запускаем нужный браузер
           If Len(Path2$) Then    ' если exe-файл нужного браузера найден, то
               ' запускаем браузер для открытия ссылки
               CreateObject("wscript.shell").Run Path$ & " " & link$
            Else
                ' выводим сообщение, что браузер не найден
               Debug.Print "Browser " & browser$ & " not found: " & Path$
            End If
        End If

        ' после первой ссылки дожидаемся запуска браузера (1 секунду)
       If n = 1 Then Application.Wait Now + 1 / 86400
    Next
End Sub