Quote Originally Posted by romperstomper View Post
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
Well that worked much better. However I am still having a small problem as I did in my last post with the if then statement. I need to use this line in my code to make the data match up correctly?

Range("P3").Delete Shift:=xlUp
I'm just curious as to why the rows don't match up? Once I delete P3 then everything is correct.

Thank You for the help...
Mike