Shell "C:\Program Files (x86)\Internet Explorer\iexplore.exe" & ActiveCell.Value, vbMinimizedFocus 'при 64 разр винде в 2-х местах сидит IE минимизируем окно открытия
Shell "C:\Program Files\Internet Explorer\iexplore.exe" & ActiveCell.Value, vbMinimizedFocus

Shell """" & ThisWorkbook.Path & "\OperaPortable\Opera.exe""" & ActiveCell.Value, vbNormalFocus 'открываем своим браузером

Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = False

Dim IE As New InternetExplorer
IE.Visible = False

operaPath = """" & ThisWorkbook.Path & "\OperaPortable\OperaPortable.exe"""
Shell (operaPath & " -url https://google.com"), vbNormalFocus

KMeleonPath = """" & ThisWorkbook.Path & "\KMeleonPortable\k-meleon.exe"""
Shell (KMeleonPath & " -url https://google.com"), vbNormalFocus

KMeleonPath = """" & ThisWorkbook.Path & "\KMeleonPortable\k-meleon.exe"""
Shell (KMeleonPath), vbNormalFocus

Shell """" & ThisWorkbook.Path & "\KMeleonPortable\k-meleon.exe""" & "https://google.com"

X = Shell("""C:\KMeleonPortable\k-meleon.exe""" & """https://google.com""", vbNormalNoFocus)

Dim Rng1 As Range, Rng2 As Range
'определяем диапазоны Rng1 и Rng2 для условий для видимых ячеек после автофильтра
'With ThisWorkbook.ActiveSheet.Range("A1:AH1000").SpecialCells(xlVisible)
'With ThisWorkbook.ActiveSheet.Range("A1:AH1000").SpecialCells(12)
With ThisWorkbook.ActiveSheet
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        Set Rng1 = .Range(.Cells(4, 7), .Cells(LastRow, 7))
   Set Rng2 = .Range(.Cells(4, 18), .Cells(LastRow, 18))


If ActiveSheet.AutoFilter.Filters(7).On Or ActiveSheet.AutoFilter.Filters(18).On Then   'если автофильтр в 7 или 18 столбце включен
'и как прописать эти условия ??
If "Значения отфильтрованных ячеек в диапазоне Rng1 одинаковы" And "Значение отфильтрованных ячеек в диапазоне Rng1 = "Test"" 
And "Значения отфильтрованных ячеек в диапазоне Rng2 одинаковы" And "Значения отфильтрованных ячеек в диапазоне Rng2 > 0" Then
'Условие1
End If
If "Значения отфильтрованных ячеек в диапазоне Rng1 неодинаковы-несовпают" And "Значения отфильтрованных ячеек в диапазоне Rng2 неодинаковы-несовпают"  Then
'Условие2
End If

Else
Exit Sub

End With

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(ActiveCell, Range("C4:C100")) Is Nothing Then
If Target.Cells.Count > 1 Then Exit Sub 
x = Shell("""" & ThisWorkbook.Path & "\OperaPortable\OperaPortable.exe""" & """http://www.planetaexcel.ru""", vbNormalNoFocus)
'operaPath = """" & ThisWorkbook.Path & "\OperaPortable\OperaPortable.exe"""
'Shell (operaPath & " -url http://www.planetaexcel.ru"), vbNormalFocus 
'Shell """" & ThisWorkbook.Path & "\OperaPortable\OperaPortable.exe""" & "http://www.planetaexcel.ru", vbNormalFocus
End If
Exit Sub

Function NumbersOnly(srcStr As String) As String
    Dim objRegEx As Object
    Set objRegEx = CreateObject("VBScript.RegExp")
    With objRegEx
        .Global = True
        .Pattern = "[^0-9,]" ' последние цифры нужны после [\s....] пробела
        NumbersOnly = .Replace(srcStr, vbNullString)
    End With
    Set objRegEx = Nothing
End Function
Function TextOnly(srcStr As String) As String
    Dim objRegEx As Object
    Set objRegEx = CreateObject("VBScript.RegExp")
    With objRegEx
        .Global = True
        .Pattern = "[0-9,]" ' все что осталось после [^....]
        TextOnly = .Replace(srcStr, vbNullString)
    End With
    Set objRegEx = Nothing
End Function
Sub TextDoCifr()
ActiveCell.Offset(0, 1).Value = TextOnly(ActiveCell.Text)
End Sub
Sub CifraRight()
ActiveCell.Offset(0, 2).Value = NumbersOnly(ActiveCell.Text)
End Sub

Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long

Shell """" & ThisWorkbook.Path & "\ChomiumPortable\chrome.exe""" & "chrome://settings/clearBrowserData", vbNormalFocus

Shell """" & ThisWorkbook.Path & "\ChomiumPortable\chrome.exe""" & "http://chrome://settings/clearBrowserData", vbNormalFocus

'http://www.excel-vba.ru/chto-umeet-excel/kak-ostavit-v-yachejke-tolko-cifry-ili-tolko-tekst/
'Для извлечения только чисел
'=Extract_Number_from_Text(A1; 0)
'или
'=Extract_Number_from_Text(A1)
'Для извлечения только текста
'=Extract_Number_from_Text(A1; 1)
Function Extract_Number_from_Text(sWord As String, Optional Metod As Integer)
'sWord = ссылка на ячейку или непосредственно текст
'Metod = 0 – числа
'Metod = 1 – текст
    Dim sSymbol As String, sInsertWord As String
    Dim i As Integer
 
    If sWord = "" Then Extract_Number_from_Text = "Нет данных!": Exit Function
    sInsertWord = ""
    sSymbol = ""
    For i = 1 To Len(sWord)
        sSymbol = Mid(sWord, i, 1)
        If Metod = 1 Then
            If Not LCase(sSymbol) Like "*[0-9]*" Then
                If (sSymbol = "," Or sSymbol = "." Or sSymbol = " ") And i > 1 Then
                    If Mid(sWord, i - 1, 1) Like "*[0-9]*" And Mid(sWord, i + 1, 1) Like "*[0-9]*" Then
                        sSymbol = ""
                    End If
                End If
                sInsertWord = sInsertWord & sSymbol
            End If
        Else
            If LCase(sSymbol) Like "*[0-9.,;:-]*" Then
                If LCase(sSymbol) Like "*[.,]*" And i > 1 Then
                    If Not Mid(sWord, i - 1, 1) Like "*[0-9]*" Or Not Mid(sWord, i + 1, 1) Like "*[0-9]*" Then
                        sSymbol = ""
                    End If
                End If
                sInsertWord = sInsertWord & sSymbol
            End If
        End If
    Next i
    Extract_Number_from_Text = sInsertWord
End Function

'ОСНОВНОЙ МАКРОС
Sub РазделениеТекста()
Dim tt As String, cifr As String
'переменная tt - тект  cifr - цифры в тексте
ActiveCell.Select
cifr = Extract_Number_from_Text(ActiveCell, 1)
tt = Extract_Number_from_Text(ActiveCell, 0)
With tt
   'убираем кавычки в тексте
   tt.Value = Replace(tt.Value, Chr(34), "")
   'убираем все переносы
   tt.Replace What:=Chr(10), Replacement:=" ", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
   'убираем лишние пробелы
   tt = Application.WorksheetFunction.Trim(tt.Value)
   'заменяем пробелы на "+" так работает браузер в поиске - если 2 слова то в поиск через + между словами
   tt = Replace(tt, " ", "+")
End With
Shell """C:\Program Files\Internet Explorer\IEXPLORE.EXE""" & "https://yandex.ru/search/?&text=" & tt, vbNormalFocus
Shell """C:\Program Files\Internet Explorer\IEXPLORE.EXE"" -new-window " & "https://yandex.ru/search/?&text=" & cifr, vbNormalFocus
'Shell """" & ThisWorkbook.Path & "\ChomiumPortable\chrome.exe""" & "https://yandex.ru/search/?&text=" & tt, vbNormalFocus
'Shell """" & ThisWorkbook.Path & "\ChomiumPortable\chrome.exe""--new--window " & "https://yandex.ru/search/?&text=" & cifr, vbNormalFocus
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'обратный закрас 1 столбец и переход сосед ячейка
If Not Intersect(Range("A4:A5003"), ActiveCell) Is Nothing Then
    Call ВыделениеСтрокиНетЦвета
    ActiveCell.Offset(0, 1).Select  'Переход на соседнюю ячейку
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'Коорд выделение + выделение белым по выд 1 столбца'макрос красим строки по клику в столбце A и защита от выделения строки
If Target.Cells.Count > 1 Then Exit Sub 'если выделено больше 1 ячейки - выходим
    If Not Intersect(Range("A4:A5003"), ActiveCell) Is Nothing Then
        For j = 1 To i
            If Rows(j).Select Then Exit Sub
        Next
Call ВыделениеСтрокиСерый
    End If
End Sub

Private Sub CommandButton6_Click()
ActiveCell.Value = Replace(ActiveCell.Value, " ", "+")
Shell """C:\Users\Max\Desktop\Проект\ChomiumPortable\chrome.exe""" & "http://ekb.rosfirm.ru/catalog?show_list=1&simple_search=1&search=Найти®ions=&field_keywords=" & ActiveCell.Value, vbNormalFocus
End Sub

Shell """ThisWorkbook.Path & "\ChomiumPortable\chrome.exe"""" & "http://ekb.rosfirm.ru/catalog?show_list=1&simple_search=1&search=Найти®ions=&field_keywords=" & ActiveCell.Value, vbNormalFocus

Private Declare Function FindWindow _    
        Lib "user32.dll" Alias "FindWindowA" ( _    
        ByVal lpClassName As String, _    
        ByVal lpWindowName As String) As Long    
Private Declare Function GetWindowLong _    
        Lib "user32.dll" Alias "GetWindowLongA" ( _    
        ByVal hWnd As Long, _    
        ByVal nIndex As Long) As Long    
Private Declare Function SetWindowLong _    
        Lib "user32.dll" Alias "SetWindowLongA" ( _    
        ByVal hWnd As Long, _    
        ByVal nIndex As Long, _    
        ByVal dwNewLong As Long) As Long    
Private Declare Function DrawMenuBar Lib "user32.dll" ( _    
        ByVal hWnd As Long) As Long    
   
Private Sub UserForm_Initialize()    
    Dim ihWnd As Long, iStyle As Long    
   
    ihWnd = FindWindow(vbNullString, Me.Caption)    
    iStyle = GetWindowLong(ihWnd, -16&)    
    SetWindowLong ihWnd, -16&, iStyle And Not &HC00000    
    DrawMenuBar ihWnd    
End Sub

Private Sub UserForm_Initialize()
If Application.Visible = True Then
UserForm1.Show
End If
If Application.Visible = False Then
UserForm1.Show
End If
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Dim cc As Range
    Dim cw As Range
    Dim dw As Long, dh As Long
   
    Set cc = Target
    Set cc = Sh.Cells(Int(cc.Row + cc.Rows.Count / 2), Int(cc.Column + cc.Columns.Count / 2))
    Set cw = ActiveWindow.VisibleRange
    Set cw = Sh.Cells(Int(cw.Row + cw.Rows.Count / 2), Int(cw.Column + cw.Columns.Count / 2))
   
    dw = cc.Column - cw.Column
    dh = cc.Row - cw.Row
   
    On Error Resume Next
   
    ActiveWindow.SmallScroll Down:=dh
    ActiveWindow.SmallScroll ToRight:=dw
   
End Sub

If Not Intersect(Range("A4:A5003"), ActiveCell) Is Nothing Then
For j = 1 To i
If Rows(j).Select Then
Exit Sub
Next

...................... мой макрос
End If