Cancel Exit on duplicate

  • Thread starter Thread starter Garry Jones
  • Start date Start date
G

Garry Jones

I have 3 text boxes on a userform, all prefilled by suggested data from
cells.

Only the current textbox is enabled, after each entry the user tabs to
the next textbox, the one they were in becomes Enabled=False and the one
they tab to becomes Enabled=True. (This is done with keypress). I also
use color defaults for each state of the textbox. (enabled=true or
false, different colours).

The user has to enter a new value.

Example for textbox1, if user enters a value that already exists in
textbox2 or textbox3 it...

....identifies that a duplicate value has been found YES

....resets Textbox1 to the old existing value YES

...but it moves the cursor to Textbox2.

This is what I want to stop happening. I need code that will cancel the
exit when the user enters an existing value.

The full version has 18 textboxes, here is a version with three with the
same problem, any help appreciated, you will need a userform with 3
textboxes and one command button.

Option Explicit
Const c1 = &HC0E0FF 'creamish
Const c2 = &HC0& 'reddish
Const c3 = &H0& 'black
Const c4 = &HFF00& 'green
Dim cancelclose As Boolean
Dim bDisableEvents As Boolean
Private CloseMode As Integer

Public Function Chknow(tb As MSForms.TextBox) As Boolean
Dim boxnumhere As Integer
Dim boxnumfrm As Variant
Dim fubar As String
CloseMode = 0
boxnumhere = 1 'boxnumber start is 1
boxnumfrm = tb.Tag 'tb.tag is number of box
'this compares new input to existing input
'if input already exists it cancels the input
'and resets it to what it was and issues msgbox warning

Do While boxnumhere < 4
If boxnumfrm <> boxnumhere Then
fubar = EnterNames("TextBox" & boxnumhere).Text
If StrComp(tb.Value, fubar, vbTextCompare) = 0 Then
MsgBox "Name Duplicate"
cancelclose = False 'somewhere here
Chknow = True 'or here
CloseMode = 0 'or here there should be a way of trapping
the user in current textbox
Exit Function
Else
CloseMode = 1
End If
Else
End If
boxnumhere = boxnumhere + 1
Loop
Chknow = False
End Function


Private Sub CommandButton1_Click()
Unload Me
End Sub

Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Cancel = Chknow(TextBox1)
End Sub

Private Sub TextBox2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Cancel = Chknow(TextBox2)
End Sub

Private Sub TextBox3_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Cancel = Chknow(TextBox3)
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If bDisableEvents Then Exit Sub
Cancel = Chknow(TextBox1)
End Sub

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If bDisableEvents Then Exit Sub
Cancel = Chknow(TextBox2)
End Sub

Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If bDisableEvents Then Exit Sub
Cancel = Chknow(TextBox3)
End Sub

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case 9: KeyAscii = 0: ntl 1
End Select
End Sub

Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case 9: KeyAscii = 0: ntl 2
End Select
End Sub

Private Sub TextBox3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case 9: KeyAscii = 0: ntl 3
End Select
End Sub

Private Sub UserForm_Initialize()

Dim i As Long

Me.CommandButton1.TabStop = True

With Me.TextBox1
.SetFocus
.Enabled = True
.TabStop = True
.TabKeyBehavior = True
.ForeColor = c3
.BackColor = c4
End With

For i = 2 To 3
With Me.Controls("textbox" & i)
.Enabled = False
.TabStop = False
.ForeColor = c1
.BackColor = c2
.TabKeyBehavior = True
End With
Next i
Me.TextBox1.SetFocus
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
Beep
Cancel = True
End If
End Sub

Private Sub ntl(bnum As Integer)

With Me.Controls("textbox" & bnum)
If Trim(.Value) = "" Then
.SetFocus
Beep

Else
bDisableEvents = True 'needed to stop Exit triggering
.Enabled = False
bDisableEvents = False
.ForeColor = c1
.BackColor = c2
If bnum < 3 Then
With Me.Controls("textbox" & bnum + 1)
.Enabled = True
.ForeColor = c3
.BackColor = c4
.SetFocus
End With
Else
Me.CommandButton1.SetFocus
End If
End If
End With
End Sub

Garry Jones
Sweden
 
can not understand what you try to imply, need just
simple code of VBA.
thanks.

Lillian
 
can not understand what you try to imply, need just
simple code of VBA.
thanks.

Okay I try again and I will simplify this.

With two textboxes.

Textbox1 contains a suggested value from a cell
Textbox2 contains a suggested value from another cell

The user form opens with Textbox1 Enabled=true and Textbox2
Enabled=false.

When the user tabs from Textbox1 my code checks to see if the user has
entered an accepted value.

I have a Public Function called chknow

This function contains this code extract to refuse value

MsgBox "Name Duplicate"
cancelclose = False
Chknow = True
CloseMode = 0
Exit Function

and this code to accept value

CloseMode = 1

I use TextBox1_BeforeUpdate to be able to reset the original value if
the user value is not accepted.

This contains
Cancel = Chknow(TextBox1)

I use TextBox1_Exit so that I can stop the user from leaving textbox1 if
the user value is not accepted.

This also contains
Cancel = Chknow(TextBox1)

I use TextBox1_KeyPress to check for user tab. When the user tabs I want
to set Enabled=False for Textbox1 and Enabled=True for Textbox2 and
place the user in Textbox2.

"TextBox1_KeyPress" contains

Select Case KeyAscii
Case 9: KeyAscii = 0: ntl 1
End Select

It sends 1 to a routine called ntl.

Somewhere in "ntl" I need to run the chknow function to see if the user
can leave textbox1. My problem is that the trap in chknow works and the
msgbox comes up if the value is not accepted, but because "keypress" is
checked before "exit" it is allowing the user to exit textbox1 even when
I don't want that to happen.

I think I have something very simple wrong, but I can't put my finger on
it.

Garry Jones
Sweden
 
Back
Top