Как заставить Vba выбирать из выпадающего списка, не вызывая каждый индекс этого списка?

Question

У меня есть раскрывающийся список со списком, и каждый раз, когда он выбирается, он показывает данные на моей панели управления vba. Однако я не знаю, что делать с бесконечным количеством заявлений IFs. Есть ли более чистый способ сделать это?

Sub DropDown1_Change()

    Dim X As Worksheet
    Set X = Sheets("Sheet1")


   If ActiveSheet.Shapes(Application.Caller).OLEFormat.Object.ListIndex = 1 Then
        lastRow = TC.Cells(Rows.Count, 2).End(xlUp).Row
        For i = 2 To lastRow
            If TC.Cells(i, 1) = "England" Then
                A = WorksheetFunction.Concat(A, Chr(10), Sheets("Sheet1").Cells(i, 4))
                ActiveSheet.Shapes("Circle 1").TextFrame2.TextRange.Characters.Text = A
            End If
            If TC.Cells(i, 3) = "Yes" And TC.Cells(i, 1) = "England" Then
                B = WorksheetFunction.Concat(B, Chr(10), Sheets("Sheet1").Cells(i, 4))
                ActiveSheet.Shapes("Circle 2").TextFrame2.TextRange.Characters.Text = B
            ElseIf TC.Cells(i, 3) = "No" And TC.Cells(i, 1) = "England" Then
                C = WorksheetFunction.Concat(C, Chr(10), Sheets("Sheet1").Cells(i, 4))
                ActiveSheet.Shapes("Circle 3").TextFrame2.TextRange.Characters.Text = C

            End If
        Next i
   If ActiveSheet.Shapes(Application.Caller).OLEFormat.Object.ListIndex = 2 Then
        lastRow = TC.Cells(Rows.Count, 2).End(xlUp).Row
        For i = 2 To lastRow
            If TC.Cells(i, 1) = "Scotland" Then
                A = WorksheetFunction.Concat(A, Chr(10), Sheets("Sheet1").Cells(i, 4))
                ActiveSheet.Shapes("Circle 1").TextFrame2.TextRange.Characters.Text = A
            End If
            If TC.Cells(i, 3) = "Yes" And TC.Cells(i, 1) = "Scotland" Then
                B = WorksheetFunction.Concat(B, Chr(10), Sheets("Sheet1").Cells(i, 4))
                ActiveSheet.Shapes("Circle 2").TextFrame2.TextRange.Characters.Text = B
            ElseIf TC.Cells(i, 3) = "No" And TC.Cells(i, 1) = "Scotland" Then
                C = WorksheetFunction.Concat(C, Chr(10), Sheets("Sheet1").Cells(i, 4))
                ActiveSheet.Shapes("Circle 3").TextFrame2.TextRange.Characters.Text = C

            End If
        Next i
   If ActiveSheet.Shapes(Application.Caller).OLEFormat.Object.ListIndex =3 Then
        lastRow = TC.Cells(Rows.Count, 2).End(xlUp).Row
        For i = 2 To lastRow
            If TC.Cells(i, 1) = "Germany" Then
                A = WorksheetFunction.Concat(A, Chr(10), Sheets("Sheet1").Cells(i, 4))
                ActiveSheet.Shapes("Circle 1").TextFrame2.TextRange.Characters.Text = A
            End If
            If TC.Cells(i, 3) = "Yes" And TC.Cells(i, 1) = "Germany" Then
                B = WorksheetFunction.Concat(B, Chr(10), Sheets("Sheet1").Cells(i, 4))
                ActiveSheet.Shapes("Circle 2").TextFrame2.TextRange.Characters.Text = B
            ElseIf TC.Cells(i, 3) = "No" And TC.Cells(i, 1) = "Germany" Then
                C = WorksheetFunction.Concat(C, Chr(10), Sheets("Sheet1").Cells(i, 4))
                ActiveSheet.Shapes("Circle 3").TextFrame2.TextRange.Characters.Text = C

            End If
        Next i

И так далее и тому подобное для всех разных стран.