Case Statement

I made this case statment below to look at a cell in Q and if the cell value is "Large Area" then the cell in P same row should be 1 if the case is Varsity then it would be 2 however I keep getting a Type Mismatch. I tried Picker.Text and Picker.Value as well I didn't get errors but it didn't work either.

Any Idea's what is wrong?

Thank You, Mike

Sub Change_one_two()
    
 Dim Picker As Range, Cell As Object
 Dim irow As Long
 Dim I As String
   
     Application.DisplayAlerts = False
     Application.ScreenUpdating = False
      
    
    Set Picker = Range("Q3", Range("Q65536").End(xlUp))
    
        irow = Picker.Row
            I = irow + 1
    
 
    For Each Cell In Picker
            If IsEmpty(Cell) Then
                GoTo gonext
            End If
            
        Select Case Picker
                
        Case "Large Area"
        Range("P" & I).Value = "1"
          
          
        Case Else '"Varsity"
          Range("P" & I).Value = "2"
             
        End Select
          
gonext:
        I = I + 1
     Next

        
        'Range("P3").Delete Shift:=xlUp
        Stop
               
         Application.DisplayAlerts = True
         Application.ScreenUpdating = True
       
             
End Sub

Try instead of selecting based on "Picker" to selecting based on "Picker.Cells"

You're selecting on a whole range rather than a particular cell.

I hope this helps!

See if this does what you need:

Sub Change_one_two()
    
 Dim Picker As Range, Cell As Object
 Dim irow As Long
 Dim I As String
   
   Application.DisplayAlerts = False
   Application.ScreenUpdating = False
      
    
    Set Picker = Range("Q3", Range("Q65536").End(xlUp))
    
        irow = Picker.Row
            I = irow + 1
    
 
    For Each Cell In Picker
            If Not IsEmpty(Cell) Then
            
        Select Case Cell.Value
                
        Case "Large Area"
         Range("P" & Cell.Row + 1).Value = "1"
          
          
        Case Else '"Varsity"
          Range("P" & Cell.Row + 1).Value = "2"
             
        End Select
          
     Next Cell

        
        'Range("P3").Delete Shift:=xlUp
'        Stop
               
         Application.DisplayAlerts = True
         Application.ScreenUpdating = True
       
             
End Sub

If it should be the same row, then change both instances of:

Cell.Row + 1

to just:

Cell.Row