Case Statement

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