When cell is blank sendkeys {UP}

[mbrandt5]

If someone could help me with this I'd greatly appreciate it and be in your debt for eternity...

I looking to make the code send keys {UP} when a blank cell is found...but holding everything true...

Option Explicit

Public waitTill As Date

#If VBA7 And Win64 Then
    ' 64 bit Excel
    'The following line is supposed to be RED in 32 bit Excel
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
    ' 32 bit Excel
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If



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
       
         '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

[LJMetzger]

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