Case Select Statement Crashes Excel

Question

Bear with me, I'm learning Excel VBA as I go so excuse any dodgy code. This one has just stumped me - I'm sure I'm missing something pretty obvious but I just can't see it!

I'm trying to refine my code from an extended IF (which works) to a Select Case with Calls to predefined Macros.

The code below seems to run and do what I want it to do, but then crashes Excel with 'Microsoft Excel has stopped working' when calling the Code or Description Macro's. When calling the Freetype Macro, I get 'Not Enough System Resources to Display Completely'

Main Worksheet Code

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

And here's my Macros:

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

Any suggestions or comments on where I've gone wrong are gratefully appreciated.

Answer 1

Cirrusone - your answer totally fixed the crash, but stopped me from selecting from the data validation list applied to the range in the macro. It just wouldn't allow anything to be added into those cells (I think each time I changed the cell it was calling the Macro again - part of which is .ClearContents on that range)

I figured out where I needed to add a line of code to stop the crash - I needed to add a With Target and then use an If to give the .Address to refer to the 'OrderBox' cell so that we're only looking for changes in that cell (E3) (I think..?).

If anyone fancies explaining it to me further though that would be really helpful to my learning.

Updated as below seems to work...

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim OrderBox As String
    OrderBox = Range("E3")
    With Target
        If .Address = ("$E$3") Then
            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 If
    End With
End Sub

Answer 2

One possible cause is that the routines you call in the Worksheet_Change event write to the sheet and re-trigger the events.

This may help

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim OrderBox As String
Application.EnableEvents = false
    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
Application.EnableEvents = true
End Sub