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

FrancisM

FrancisM

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
 
FrancisM said:
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
Click to expand...
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
 
AmjiBhai said:
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
Click to expand...
Perfect. Thank you.
 
Back
Top