vba - Case Select ステートメントで Excel がクラッシュする

Question

私はExcel VBAを学んでいるので、危険なコードは許してください。これは私を困惑させました-私はかなり明白な何かを見逃していると確信していますが、私はそれを見ることができません!

拡張 IF (動作する) から、事前定義されたマクロへの呼び出しを含む Select Case にコードを改良しようとしています。

以下のコードは実行され、やりたいことを実行しているように見えますが、コードまたは説明マクロを呼び出すと、「Microsoft Excel が動作を停止しました」というメッセージが表示されて Excel がクラッシュします。Freetype マクロを呼び出すと、「完全に表示するにはシステム リソースが不足しています」というメッセージが表示されます

メイン ワークシート コード

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim OrderBox As String
    OrderBox = Range("E3")
        Select Case OrderBox
            Case "Order by Description"
                Call UnProtect(1234)
                Call Description
                Call Protect(1234)
            Case "Order by Code"
                Call UnProtect(1234)
                Call Code
                Call Protect(1234)
            Case "Free Type"
                Call UnProtect(1234)
                Call Freetype
                Call Protect(1234)
        End Select
End Sub

そして、ここに私のマクロがあります：

Sub Protect(myPassword As String)
    ActiveWorkbook.Sheets.Protect
    Password = myPassword
    ActiveWorkbook.Protect
    Password = myPassword
End Sub

Sub UnProtect(myPassword As String)
    ActiveWorkbook.ActiveSheet.UnProtect
    Password = myPassword
    ActiveWorkbook.UnProtect
    Password = myPassword
End Sub

Sub Description()
    Dim Range1 As Range, Range2 As Range, Range3 As Range
    Set Range1 = Range("A18:B23")
    Set Range2 = Range("A18:A23")
    Set Range3 = Range("B18:B23")
    Range1.Locked = False
        Range1.Validation.Delete
            Range3.Select
            With Selection.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:="=indirect(""databydesc[description]"")"
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
            End With
    Range2.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[1],DATABYDESC,2,FALSE),"""")"
    Range3.ClearContents
        Range2.Locked = True
        Range("B18").Select
End Sub

Sub Code()
    Dim Range1 As Range, Range2 As Range, Range3 As Range
    Set Range1 = Range("A18:B23")
    Set Range2 = Range("A18:A23")
    Set Range3 = Range("B18:B23")
    Range1.Locked = False
        Range1.Validation.Delete
            Range2.Select
            With Selection.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:="=indirect(""databycode[code]"")"
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
            End With
    Range3.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-1],DATABYCODE,2,FALSE),"""")"
    Range2.ClearContents
        Range3.Locked = True
        Range("A18").Select
End Sub

Sub Freetype()
    Range("A18:B23").Locked = False
        Range("A18:B23").Validation.Delete
        Range("A18:B23").ClearContents
    Range("B18").Select
    Range("A18").Select
End Sub

私が間違っていた場所についての提案やコメントは、感謝しています。