Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
With TextBox1
If IsNumeric(.Value) Then .Value = Format(.Value, "#,##0")
ActiveCell = .Value
End With
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.CountLarge <> 1 Then Exit Sub
With Me.TextBox1
.Value = Target
If IsNumeric(.Value) Then .Value = Format(.Value, "#,##0")
.Top = ActiveCell.Top
.Left = ActiveCell.Left
.Height = ActiveCell.Height
.Width = ActiveCell.Width
.Activate
End With
End Sub
Hi and welcome from me as well!
I can offer this as a starting point. You might need to experiment to get it as you want it.
The font always overfills the TextBox so you will probably need to change the row spacing (or make the TextBox font smaller).
Add an ActiveX TextBox named TextBox1 to the Worksheet then paste this code into the code module for that Sheet.
Every time the Selection changes, the TextBox moves into that Cell.Code:Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) With TextBox1 If IsNumeric(.Value) Then .Value = Format(.Value, "#,##0") ActiveCell = .Value End With End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.CountLarge <> 1 Then Exit Sub With Me.TextBox1 .Value = Target If IsNumeric(.Value) Then .Value = Format(.Value, "#,##0") .Top = ActiveCell.Top .Left = ActiveCell.Left .Height = ActiveCell.Height .Width = ActiveCell.Width .Activate End With End Sub
When you enter a number it formats it and displays it as you go along.
Regards,
' List of KeyCodes - https://msdn.microsoft.com/en-us/library/aa243025(v=vs.60).aspx
Private Sub TextBox1_Keydown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
On Error GoTo err ' Traps moves to illegal cells e.g. on Row/Column = -1.
With ActiveCell
Select Case KeyCode
Case vbKeyTab
If Shift Then .Offset(0, -1).Activate Else .Offset(0, 1).Activate
Case vbKeyLeft: .Offset(0, -1).Activate
Case vbKeyRight: .Offset(0, 1).Activate
Case vbKeyUp: .Offset(-1, 0).Activate
Case vbKeyDown: .Offset(1, 0).Activate
Case vbKeyReturn
Select Case Application.MoveAfterReturnDirection
Case xlToLeft: .Offset(0, -1).Activate
Case xlToRight: .Offset(0, 1).Activate
Case xlUp: .Offset(-1, 0).Activate
Case xlDown: .Offset(1, 0).Activate
End Select
End Select
End With
err:
End Sub
Private Sub TextBox1_Keyup(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
With ActiveCell
Select Case KeyCode
Case vbKeyTab, vbKeyLeft, vbKeyRight, vbKeyUp, vbKeyDown, vbKeyReturn
Case Else
With TextBox1
If IsNumeric(.Value) Then .Value = Format(.Value, "#,##0")
ActiveCell = .Value
End With
End Select
End With
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.CountLarge <> 1 Then Exit Sub
With Me.TextBox1
If Not Intersect(Target, Range("A4:F17")) Is Nothing Then
.Value = Target
If IsNumeric(.Value) Then .Value = Format(.Value, "#,##0")
.Top = ActiveCell.Top
.Left = ActiveCell.Left
.Height = ActiveCell.Height
.Width = ActiveCell.Width
.Activate
Else
.Visible = False
End If
End With
End Sub
This is a step up from the previous code:
As Kenneth suggested, it is usually better to restrict this type of operation to a defined Range of Cells. So I have added the Intersect option. The Range considered is A4:F17 as shown in red above. Change that to whatever works for you.Rich (BB code):' List of KeyCodes - https://msdn.microsoft.com/en-us/library/aa243025(v=vs.60).aspx Private Sub TextBox1_Keydown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) On Error GoTo err ' Traps moves to illegal cells e.g. on Row/Column = -1. With ActiveCell Select Case KeyCode Case vbKeyTab If Shift Then .Offset(0, -1).Activate Else .Offset(0, 1).Activate Case vbKeyLeft: .Offset(0, -1).Activate Case vbKeyRight: .Offset(0, 1).Activate Case vbKeyUp: .Offset(-1, 0).Activate Case vbKeyDown: .Offset(1, 0).Activate Case vbKeyReturn Select Case Application.MoveAfterReturnDirection Case xlToLeft: .Offset(0, -1).Activate Case xlToRight: .Offset(0, 1).Activate Case xlUp: .Offset(-1, 0).Activate Case xlDown: .Offset(1, 0).Activate End Select End Select End With err: End Sub Private Sub TextBox1_Keyup(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) With ActiveCell Select Case KeyCode Case vbKeyTab, vbKeyLeft, vbKeyRight, vbKeyUp, vbKeyDown, vbKeyReturn Case Else With TextBox1 If IsNumeric(.Value) Then .Value = Format(.Value, "#,##0") ActiveCell = .Value End With End Select End With End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.CountLarge <> 1 Then Exit Sub With Me.TextBox1 If Not Intersect(Target, Range("A4:F17")) Is Nothing Then .Value = Target If IsNumeric(.Value) Then .Value = Format(.Value, "#,##0") .Top = ActiveCell.Top .Left = ActiveCell.Left .Height = ActiveCell.Height .Width = ActiveCell.Width .Activate Else .Visible = False End If End With End Sub
If you need to process other Key Codes then you can end up re-writing quite a lot of existing functionality. The problem is knowing when to stop!
I have picked up the Excel Option that specifies the action when Enter is pressed and used that to move the TextBox. I have also detected the Tab and Arrow keys.
The TextBox becomes invisible when using a Cell outside the defined Range.
Note: I added an On Error step to ignore moves to Row -1 etc. That could be made smarter.
Regards,