How to overwrite suggest text in textbox during typing? - excel

Question

I have Userform using Textbox to input date.
I'd like to show suggestion text before input like __ /__/____ (same format dd/mm/yyyy)
When enter this Textbox, cursor always in beginning. When I typing, each _ symbol will be replaced by number, and skip / symbol.
For example: I just type 05041991, in Textbox will show 05/04/1991.
Please help me about this code.

Answer 1

You could do something like shown below. This code is just an example (probably not perfect).
Image 1: Note that only number keys and backspace were pressed.
Put the following code into a class module and name it MaskedTextBox
Option Explicit
Public WithEvents mTextBox As MSForms.TextBox
Private mMask As String
Private mMaskPlaceholder As String
Private mMaskSeparator As String
Public Enum AllowedKeysEnum
NumberKeys = 1 '2^0
CharacterKeys = 2 '2^1
'for more options next values need to be 2^2, 2^3, 2^4, …
End Enum
Private mAllowedKeys As AllowedKeysEnum
Public Sub SetMask(ByVal Mask As String, ByVal MaskPlaceholder As String, ByVal MaskSeparator As String, Optional ByVal AllowedKeys As AllowedKeysEnum = NumberKeys)
mMask = Mask
mMaskPlaceholder = MaskPlaceholder
mMaskSeparator = MaskSeparator
mAllowedKeys = AllowedKeys
mTextBox.Text = mMask
FixSelection
End Sub
' move selection so separators get not replaced
Private Sub FixSelection()
With mTextBox
Dim Sel As Long
Sel = InStr(1, .Text, mMaskPlaceholder) - 1
If Sel >= 0 Then
.SelStart = Sel
.SelLength = 1
End If
End With
End Sub
Private Sub mTextBox_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim tb As MSForms.TextBox
Set tb = Me.mTextBox
'allow paste
If Shift = 2 And KeyCode = vbKeyV Then
On Error Resume Next
Dim DataObj As MSForms.DataObject
Set DataObj = New MSForms.DataObject
DataObj.GetFromClipboard
Dim PasteData As String
PasteData = DataObj.GetText(1)
On Error GoTo 0
If PasteData <> vbNullString Then
Dim LikeMask As String
LikeMask = Replace$(mMask, mMaskPlaceholder, "?")
If PasteData Like LikeMask Then
mTextBox = PasteData
End If
End If
End If
Select Case KeyCode
Case vbKey0 To vbKey9, vbKeyNumpad0 To vbKeyNumpad9
'allow number keys
If Not (mAllowedKeys And NumberKeys) = NumberKeys Then
KeyCode = 0
ElseIf Len(tb.Text) >= Len(mMask) And InStr(1, tb.Text, mMaskPlaceholder) = 0 Then
KeyCode = 0
End If
Case vbKeyA To vbKeyZ
'allow character keys
If Not (mAllowedKeys And CharacterKeys) = CharacterKeys Then
KeyCode = 0
ElseIf Len(tb.Text) >= Len(mMask) And InStr(1, tb.Text, mMaskPlaceholder) = 0 Then
KeyCode = 0
End If
Case vbKeyBack
'allow backspace key
KeyCode = 0
If tb.SelStart > 0 Then 'only if not first character
If Mid$(tb.Text, tb.SelStart, 1) = mMaskSeparator Then
'jump over separators
tb.SelStart = tb.SelStart - 1
End If
'remove character left of selection and fill in mask
If tb.SelLength <= 1 Then
tb.Text = Left$(tb.Text, tb.SelStart - 1) & Mid$(mMask, tb.SelStart, 1) & Right$(tb.Text, Len(tb.Text) - tb.SelStart)
End If
End If
'if whole value is selected replace with mask
If tb.SelLength = Len(mMask) Then tb.Text = mMask
Case vbKeyReturn, vbKeyTab, vbKeyEscape
'allow these keys
Case Else
'disallow any other key
KeyCode = 0
End Select
FixSelection
End Sub
Private Sub mTextBox_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
FixSelection
End Sub
Put the following code into your userform
Option Explicit
Private MaskedTextBoxes As Collection
Private Sub UserForm_Initialize()
Set MaskedTextBoxes = New Collection
Dim MaskedTextBox As MaskedTextBox
'init TextBox1 as date textbox
Set MaskedTextBox = New MaskedTextBox
Set MaskedTextBox.mTextBox = Me.TextBox1
MaskedTextBox.SetMask Mask:="__/__/____", MaskPlaceholder:="_", MaskSeparator:="/"
MaskedTextBoxes.Add MaskedTextBox
'init TextBox2 as barcode textbox
Set MaskedTextBox = New MaskedTextBox
Set MaskedTextBox.mTextBox = Me.TextBox2
MaskedTextBox.SetMask Mask:="____-____-____", MaskPlaceholder:="_", MaskSeparator:="-", AllowedKeys:=CharacterKeys + NumberKeys
MaskedTextBoxes.Add MaskedTextBox
End Sub