Excel VBA to move cursor from 1 cell to another, once original cell is filled with data.

Joined
Dec 13, 2017
Messages
71
Reaction score
19
I am trying to find code that does what the title says. Here is what I see happening:
  • The cursor starts in column B, date is entered, & moves to column C.
  • Name is entered in column C & the cursor moves to column D.
  • The Social Security is entered in column D, & moves to column E.
  • The referral source is entered & there is no further auto movement.
Note: the cell range would be B3:E329.
Column D has VBA code that removes the first 5 numbers of the social security.
Is this possible? I have found code to fill cell range with a number sequence , but nothing like what I am proposing.
 
Last edited:
The following code starts in B3, but does not move to the next cell. Could someone tell me what I am missing?
Code:
Worksheets("Referrals").Activate
   'Finds the next empty cell in Date column.
    ActiveSheet.Range("B2:B329").Find("").Select
     'use trim to avoide blank spaces
      If Trim(ActiveCell) = "" Then
        MsgBox "Please enter the date of the consult.", vbInformation, "Vocational Services Reminder"
        Set KeyCells = Range("B2:B329")
        If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then
            End If
            Else
            'Moves to column C (Name)
               ActiveCell.Offset(0, 1).Select
               'use trim to avoide blank spaces
                If Trim(ActiveCell) = "" Then
                  MsgBox "Please enter the name directly from CPRS.", vbInformation, "Vocational Services Reminder"
                  Set KeyCells = Range("C2:C329")
                  If Not Application.Intersect(KeyCells, Range(Target.Address)) _
                     Is Nothing Then
                      End If
                      Else
                      'Moves to column D (Social Security)
                        ActiveCell.Offset(0, 1).Select
                       'use trim to avoide blank spaces
                       If Trim(ActiveCell) = "" Then
                        MsgBox "The system will leave the last 4.", vbInformation, "Vocational Services Reminder"
                        Set KeyCells = Range("D2:D329")
                        If Not Application.Intersect(KeyCells, Range(Target.Address)) _
                           Is Nothing Then
                           End If
                           Else
                           'Moves to column D (Social Security)
                             ActiveCell.Offset(0, 1).Select
                             'use trim to avoide blank spaces
                             If Trim(ActiveCell) = "" Then
                              MsgBox "The system will leave the last 4.", vbInformation, "Vocational Services Reminder"
                              Set KeyCells = Range("D2:D329")
                              If Not Application.Intersect(KeyCells, Range(Target.Address)) _
                                 Is Nothing Then
                                 End If
                                 Else
       End If
        End If
         End If
          End If
End Sub
 
The following code starts in B3, but does not move to the next cell. Could someone tell me what I am missing?
Code:
Worksheets("Referrals").Activate
   'Finds the next empty cell in Date column.
    ActiveSheet.Range("B2:B329").Find("").Select
     'use trim to avoide blank spaces
      If Trim(ActiveCell) = "" Then
        MsgBox "Please enter the date of the consult.", vbInformation, "Vocational Services Reminder"
        Set KeyCells = Range("B2:B329")
        If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then
            End If
            Else
            'Moves to column C (Name)
               ActiveCell.Offset(0, 1).Select
               'use trim to avoide blank spaces
                If Trim(ActiveCell) = "" Then
                  MsgBox "Please enter the name directly from CPRS.", vbInformation, "Vocational Services Reminder"
                  Set KeyCells = Range("C2:C329")
                  If Not Application.Intersect(KeyCells, Range(Target.Address)) _
                     Is Nothing Then
                      End If
                      Else
                      'Moves to column D (Social Security)
                        ActiveCell.Offset(0, 1).Select
                       'use trim to avoide blank spaces
                       If Trim(ActiveCell) = "" Then
                        MsgBox "The system will leave the last 4.", vbInformation, "Vocational Services Reminder"
                        Set KeyCells = Range("D2:D329")
                        If Not Application.Intersect(KeyCells, Range(Target.Address)) _
                           Is Nothing Then
                           End If
                           Else
                           'Moves to column D (Social Security)
                             ActiveCell.Offset(0, 1).Select
                             'use trim to avoide blank spaces
                             If Trim(ActiveCell) = "" Then
                              MsgBox "The system will leave the last 4.", vbInformation, "Vocational Services Reminder"
                              Set KeyCells = Range("D2:D329")
                              If Not Application.Intersect(KeyCells, Range(Target.Address)) _
                                 Is Nothing Then
                                 End If
                                 Else
       End If
        End If
         End If
          End If
End Sub
with slight variation in your code I managed to have it moved to the first cell of empty date...



Sub fantastic()
ActiveSheet.Range("B1").Select
ActiveSheet.Range("B1") = "Date"
Worksheets("sheet1").Activate
'Finds the next empty cell in Date column.
ActiveSheet.Range("B2:B329").Find("").Select
'use trim to avoide blank spaces
If Trim(ActiveCell) = "" Then
MsgBox "Please enter the date of the consult.", vbInformation, "Vocational Services Reminder"
Set KeyCells = Range("B2:B329")

Else
'Moves to column C (Name)
ActiveCell.Offset(0, 1).Select
'use trim to avoide blank spaces
If Trim(ActiveCell) = "" Then
MsgBox "Please enter the name directly from CPRS.", vbInformation, "Vocational Services Reminder"
Set KeyCells = Range("C2:C329")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
End If
Else
'Moves to column D (Social Security)
ActiveCell.Offset(0, 1).Select
'use trim to avoide blank spaces
If Trim(ActiveCell) = "" Then
MsgBox "The system will leave the last 4.", vbInformation, "Vocational Services Reminder"
Set KeyCells = Range("D2:D329")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
End If
Else
'Moves to column D (Social Security)
ActiveCell.Offset(0, 1).Select
'use trim to avoide blank spaces
If Trim(ActiveCell) = "" Then
MsgBox "The system will leave the last 4.", vbInformation, "Vocational Services Reminder"
Set KeyCells = Range("D2:D329")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
End If
Else
End If
End If
End If
End If
End Sub
 
with slight variation in your code I managed to have it moved to the first cell of empty date...



Sub fantastic()
ActiveSheet.Range("B1").Select
ActiveSheet.Range("B1") = "Date"
Worksheets("sheet1").Activate
'Finds the next empty cell in Date column.
ActiveSheet.Range("B2:B329").Find("").Select
'use trim to avoide blank spaces
If Trim(ActiveCell) = "" Then
MsgBox "Please enter the date of the consult.", vbInformation, "Vocational Services Reminder"
Set KeyCells = Range("B2:B329")

Else
'Moves to column C (Name)
ActiveCell.Offset(0, 1).Select
'use trim to avoide blank spaces
If Trim(ActiveCell) = "" Then
MsgBox "Please enter the name directly from CPRS.", vbInformation, "Vocational Services Reminder"
Set KeyCells = Range("C2:C329")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
End If
Else
'Moves to column D (Social Security)
ActiveCell.Offset(0, 1).Select
'use trim to avoide blank spaces
If Trim(ActiveCell) = "" Then
MsgBox "The system will leave the last 4.", vbInformation, "Vocational Services Reminder"
Set KeyCells = Range("D2:D329")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
End If
Else
'Moves to column D (Social Security)
ActiveCell.Offset(0, 1).Select
'use trim to avoide blank spaces
If Trim(ActiveCell) = "" Then
MsgBox "The system will leave the last 4.", vbInformation, "Vocational Services Reminder"
Set KeyCells = Range("D2:D329")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
End If
Else
End If
End If
End If
End If
End Sub
Perfect. Thank you.
 
Back
Top