Запуск макроса с выпадающим списком

Question

Я пытаюсь вызвать макрос с выпадающим списком. Пока у меня есть рабочий макрос, который выбирает и сортирует данные по столбцу от наибольшего до наименьшего. Макрос работает отлично.

Пример Macro:

Sub Macro1() 
' 
' Macro1 Macro 
' 
' Keyboard Shortcut: Option+Cmd+s 
' 
    Range("A1:AO125").Select 
    Range("A2").Activate 
    ActiveWorkbook.Worksheets("Test Model").Sort.SortFields.Clear 
    ActiveWorkbook.Worksheets("Test Model").Sort.SortFields.Add Key:=Range(_ 
     "R2:R125"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _ 
     xlSortNormal 
    With ActiveWorkbook.Worksheets("Test Model").Sort 
     .SetRange Range("A1:AO125") 
     .Header = xlYes 
     .MatchCase = False 
     .Orientation = xlTopToBottom 
     .SortMethod = xlPinYin 
     .Apply 
    End With 
    Range("C7").Select 
End Sub 

Я хотел бы, чтобы вызвать этот макрос с помощью выпадающего списка. Я создал раскрывающийся список и написал некоторый синтаксис в редакторе VB в колонке книги excel.

Синтаксис до сих пор:

Private Sub Worksheet_Change(ByVal Target As Range) 

If Not Intersect(Target, Range("J15")) Is Nothing Then 

    Select Case Range("J15") 


     Case "Engagement Rate % ": Macro1 


    End Select 

End If 

End Sub 

Когда я пытаюсь не запускать код происходит ничего ... Может кто-нибудь помочь мне с моим синтаксисом?

Я добавил снимок экрана ниже, чтобы помочь с объяснением.

Answer 1

Просто измените код в Worksheet_Change события в коде ниже.

Это будет вызывать Macro1, если значение в ячейке «J15» является «Скорость Обручальной%» (с пробела в конце?!).

Private Sub Worksheet_Change(ByVal Target As Range) 

Application.EnableEvents = True ' <-- just for tests 
If Not Intersect(Target, Range("J15")) Is Nothing Then  
    Select Case Target.Value 
     Case "Engagement Rate % " 
      Macro1 

    End Select  
End If 

End Sub 

И попробуйте этот код вместо вашего "Macro1" (см если MsgBox хлопки):

Option Explicit 

Sub Macro1() 
    ' Macro1 Macro 
    ' Keyboard Shortcut: Option+Cmd+s 

    MsgBox "Hello Test" 
    'Range("A1:AO125").Select 
    'Range("A2").Activate 

    With Worksheets("Test Model") 
     .Sort.SortFields.Clear 
     .Sort.SortFields.Add Key:=Range("R2:R125"), SortOn:=xlSortOnValues, Order:=xlDescending, _ 
          DataOption:=xlSortNormal 

     With .Sort 
      .SetRange Range("A1:AO125") 
      .Header = xlYes 
      .MatchCase = False 
      .Orientation = xlTopToBottom 
      .SortMethod = xlPinYin 
      .Apply 
     End With 
     '.Activate ' <-- not sure why it's needed 
     '.Range("C7").Select ' <-- not sure why it's needed 
    End With 

End Sub