Data Entry Macro

[Jeffrey Smith]

I thought I would share some code for a Macro I created with help that I got from other peoples questions and answers. These macros allow a person to enter data across any number of columns the user needs from input. When the user starts the macro, they choose the columns and then the macro will move the cursor to the right when anything is entered into the cell. If the cell is empty it moves down one row and the back to the first column. When you reach the last column, it also moves down and back to the first column. You can change macro to move the cursor any way you like.

You'll need to create two defined ranges on the spreadsheet in which you're working; the "fast" macro saves the column numbers for the "faster" macro. The code shows you the names.

Once you're done with the macro, you can stop it by entering the letter "Q" in a blank cell, or you can run the "Stopfast" maco.

Hope you like it.


Sub Fast()

Dim VarRange As Variant
Dim ColA As Integer, ColB As Integer

On Error GoTo JellyBean
VarRange = ActiveCell.Address
Set VarRange = Application.InputBox("Select the columns in which you want to enter data.", "Fast Data Entry Column Chooser", VarRange, 300, -50, , , 8)
On Error GoTo 0
If IsObject(VarRange) = False Then Exit Sub

VarRange.Select
ColA = Selection.Column
ColB = Selection.Columns.Count + ColA - 1
'You'll need to create a defined range named "Col1" on the spreadsheet
Range("Col1") = ColA
'You'll need to create a defined range named "Col2" on the spreadsheet
Range("Col2") = ColB
ActiveCell.Offset(0, 1).Select
ActiveCell.Offset(0, -1).Select

'Numeric Pad Only
Application.OnKey "{ENTER}", "Faster"
Application.OnKey "~", "Faster"
'If you want the other ENTER Key, Use ~ (tilde)

JellyBean:
End Sub
Sub StopFast()
Application.OnKey "{ENTER}", ""
Application.OnKey "~", ""

End Sub

Sub Faster()

Dim BegCol As Integer, EndCol As Integer
Dim CC As Integer, Dist As Integer

Application.EnableEvents = False
BegCol = Range("Col1").Value
EndCol = Range("Col2").Value
Dist = BegCol - EndCol

If UCase(ActiveCell.Text) = "Q" Then
ActiveCell.ClearContents
Call StopFast
Exit Sub
End If

CC = ActiveCell.Column 'Current Column
If CC >= BegCol And CC < EndCol Then
If ActiveCell.Text = "" Then
ActiveCell.Offset(1, BegCol - CC).Select
Else
ActiveCell.Offset(0, 1).Select
End If
ElseIf CC > EndCol - 1 Then
ActiveCell.Offset(1, BegCol - CC).Select
End If

Application.EnableEvents = True
End Sub