Snasui Excel Forum

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
'MsgBox Len(Target.Text)
'MsgBox Asc(Target.Text)
If Len(Target.Text) > 0 Then
    If Asc(Target.Text) < 48 Then
        MsgBox "Character invalid"
        Cells(Target.Row, 1).Select
        Cells(Target.Row, 1).Clear
    ElseIf Asc(Target.Text) > 57 Then
        MsgBox "Character invalid"
        Cells(Target.Row, 1).Select
        Cells(Target.Row, 1).Clear
    ElseIf Len(Target.Text) = 1 Then
        MsgBox "Len Lesthen"
        Cells(Target.Row, 1).Select
        Cells(Target.Row, 1).Clear
    ElseIf Len(Target.Text) > 2 Then
        MsgBox "Len More"
        Cells(Target.Row, 1).Select
        Cells(Target.Row, 1).Clear
    ElseIf Target.Column > 1 Then
        Cells(Target.Row + 1, 1).Select
    End If
End If

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    'Range("A1").Select
    'ActiveCell.FormulaR1C1 = "MyJan"
End Sub

Code: Select all

Option Explicit

Dim i As Long

Sub KeyEventOn()
    For i = 48 To 57
        Application.OnKey "{" & i & "}", "'EnterToNextCell """ & i & """'"
    Next
End Sub

Sub KeyEventOff()
    For i = 47 To 57
        Application.OnKey "{" & i & "}"
    Next
End Sub

Sub EnterToNextCell(ByVal KeyCode As Long)
    Dim strText As String
    If Not TypeOf Selection Is Range Then Exit Sub
    strText = Selection.Value & Chr(KeyCode)
    Selection.Value = strText
    If Len(Selection) >= 2 Then
        Application.SendKeys "{ENTER}"
    End If
End Sub

Code: Select all

Option Explicit

Dim i As Long

Sub KeyEventOn()
    For i = 48 To 57
        Application.OnKey "{" & i & "}", "'EnterToNextCell """ & i & """'"
    Next
End Sub

Sub KeyEventOff()
    For i = 47 To 57
        Application.OnKey "{" & i & "}"
    Next
End Sub

Sub EnterToNextCell(ByVal KeyCode As Long)
    Dim strText As String
    If Not TypeOf Selection Is Range Then Exit Sub
    strText = Selection.Value & Chr(KeyCode)
    Selection.Value = strText
    If Len(Selection) >= 2 Then
        Application.SendKeys "{ENTER}"
    End If
End Sub

Code: Select all

Option Explicit

Dim i As Long

Sub KeyEventOn()
    For i = 48 To 57
        Application.OnKey "{" & i & "}", "'EnterToNextCell """ & i & """'"
    Next
End Sub

Sub KeyEventOff()
    For i = 47 To 57
        Application.OnKey "{" & i & "}"
    Next
End Sub

Sub EnterToNextCell(ByVal KeyCode As Long)
    Dim strText As String
    If Not TypeOf Selection Is Range Then Exit Sub
    strText = Selection.Value & Chr(KeyCode)
    Selection.Value = strText
'MsgBox Chr(KeyCode) & Selection.Value
Select Case (Selection.Column)
    Case 1
        'MsgBox "1"
        If Len(Selection) >= 2 Then
            Application.SendKeys "{ENTER}"
        End If
    Case 2, 6
        'MsgBox "2"
         If Len(Selection) >= 3 Then
            Application.SendKeys "{ENTER}"
        End If
    Case 3
        'MsgBox "3"
         If Len(Selection) >= 2 Then
            Application.SendKeys "{ENTER}"
        End If
    Case 4
        'MsgBox "4"
         If Len(Selection) >= 3 Then
            Application.SendKeys "{ENTER}"
        End If
    Case 5
        'MsgBox "5"
         If Len(Selection) >= 4 Then
            Application.SendKeys "{ENTER}"
        End If
    Case Else
        If Len(Selection) >= 2 Then
            Application.SendKeys "{ENTER}"
        End If
    
 End Select
   
    'If Len(Selection) >= 2 Then
    '    Application.SendKeys "{ENTER}"
    'End If
End Sub

Code: Select all

Option Explicit

Dim i As Long

Sub KeyEventOn()
    For i = 48 To 57
        Application.OnKey "{" & i & "}", "'EnterToNextCell """ & i & """'"
    Next
End Sub

Sub KeyEventOff()
    For i = 47 To 57
        Application.OnKey "{" & i & "}"
    Next
End Sub

Sub EnterToNextCell(ByVal KeyCode As Long)
    Dim strText As String
    If Not TypeOf Selection Is Range Then Exit Sub
    strText = Selection.Value & Chr(KeyCode)
    Selection.Value = strText
    Select Case Selection.Column
        Case 3
            'MsgBox "2"
             If Len(Selection) >= 2 Then
                Application.SendKeys "{ENTER}"
            End If
        Case 6
            'MsgBox "5"
             If Len(Selection) >= 3 Then
                Application.SendKeys "{ENTER}"
            End If
     End Select
End Sub