When cell is blank sendkeys {UP}

Try the following (changes in red):

Sub Lookup()
  Dim iColumn As Long
   Dim iLastColumn As Long
   Dim iRow As Long
   
   Dim bNeedMore As Boolean
   
   Dim Sel As String
   Dim MoveDown As String
   Dim pH As Single
   Dim Program As String
   Dim sValue As String


   iLastColumn = Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

  For iColumn = 1 To iLastColumn
  
     'Reset the Row to the row before the first row
     iRow = 0
     
     Debug.Print "''''''''''''''''''"
     'Loop Until there is a blank value in a cell
     bNeedMore = True
     While bNeedMore = True
     
       'Increment the Row Number
       'Get the next value as text without leading and trailing spaces
       iRow = iRow + 1
       sValue = Trim(Cells(iRow, iColumn).Value)
       Debug.Print iRow, iColumn, sValue             'Output to Immediate Window (CTRL G) in debugger

      If IsNumeric(sValue) Then

        'Convert the string to a numeric value
         pH = CSng(sValue)

        'Process as required
         If pH >= 1 Then
           Program = pH 'PROGRAM IS NOW THE OUTPUT TO A SECOND APP
         ElseIf pH < 1 Then
           Program = ""
         End If

      Else
       
         'Send the Keycode for the UP ARROW KEY
         'only if the value in the cell is BLANK
         '(i.e. 0 length after removing leading and trailing Spaces)
         If Len(sValue) = 0 Then
           Application.SendKeys "{UP}", True
         End If
         
         'Cell value is NOT a number - done processing this column
         bNeedMore = False
         Program = ""
         Debug.Print "''''''''''''''''''"
       
       End If

      Application.SendKeys "%{ESC}", True
       
       Sleep 1

      Application.SendKeys Program, True  'THIS IS WHERE THE OUTPUT OCCURS
       
       Sleep 1                          'ADD THIS LINE

      Application.SendKeys "{UP}", True  'THIS IS WHERE THE OUTPUT OCCURS
       
       Sleep 1                          'ADD THIS LINE
       
       Application.SendKeys "%{ESC}", True

     
   Wend
   
   Next iColumn

End Sub