Do seaching in excel on typing - vba

I am dealing with data input. Every time before I input one record, I need to search and locate one cell in about 5000 rows. I am thinking if it is possible to do the search while typing instead of using the search function in excel. My idea is to capture the keypress event of a spreadsheet, if it is a character (letter 'A' to 'Z' or 'a' to 'z'), append it to a string called searchVal do the search immediate with a function. When the user press ESC, it will clean up the searchVal. First of all, I got the following code from online, trying to capture the ESC keydown
Private searchVal As String
Private Sub Workbook_Activate()
Application.OnKey "ESC", "CleanSearchKey"
End Sub
Private Sub Workbook_Deactivate()
Application.OnKey "ESC"
End Sub
Sub CleanSearchKey()
searchVal = ""
MsgBox "CleanSearchKey"
End Sub
But his code doesn't work, it seems that the CleanSearchKey never triggered. As for capturing the key down for 'A' to 'Z' and 'a' to 'z', I don't want know how to capture it in a sheet so I add an inputbox on sheet1, assigned the following macro to the inputbox
Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If (KeyAscii >= 65 And KeyAscii <= 90) Or (KeyAscii >= 97 And KeyAscii <= 122) Then
searchVal = searchVal & KeyAscii
Else
KeyAscii = 0
End If
End Sub
But it then said "Compile error: User-defined type not defined". So what is the right way to capture the key on a sheet? Thanks.

The code you added for a TextBox is only applicable to a TextBox which appears on a UserForm object. I don't think text boxes on worksheets respond to events like KeyPress.
That said, you could easily configure a simple userform to do this.
I modified your code a little bit. I think this should get you started. In a normal code module, do a procedure like this which will launch the UserForm. This will allow you to show the form from the Macros ribbon menu. Otherwise, you will have to invoke it manually from the Immediate Window or by pressing F5 in the VBE.
Sub ShowForm()
UserForm1.Show vbModeless
End Sub
Create a UserForm, and add a textbox. Its default name should be TextBox1, if it is not, then make sure to change it. In the userForm's code module, do this:
Option Explicit
Dim searchVal As String
Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
searchVal = TextBox1.Value
If (KeyAscii >= 65 And KeyAscii <= 90) Or (KeyAscii >= 97 And KeyAscii <= 122) Then
searchVal = searchVal & Chr(KeyAscii)
TextBox1.Value = searchVal
Call FindValue
End If
If KeyAscii = 27 Then 'ESC
searchVal = vbNullString
TextBox1.Value = vbNullString
Else:
KeyAscii = 0
End If
End Sub
Sub FindValue()
Dim rngFound as Range
With ActiveSheet
set rngFound = .Cells.Find(searchVal)
End With
If rngFound Is Nothing Then
MsgBox searchVal & " not found!"
Else
MsgBox searchVal & " found at " & rngFound.Address
End If
End Sub

Related

How can i make a sub for a keypress event?

I'm working on an excel with macros. I have a userform with textboxes, several of them use a function for only press numbers.
Private Sub quantity1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case Asc("0") To Asc("9")
Case Else
KeyAscii = 0
End Select
End Sub
How can i put the select case on a procedure or function
and then call it from any keypress event that i need it (in this case, quantity1 quantity2, price1 and price2, but no in buyer)?
I tried making a sub that uses the same parameters like the event e.g:
Sub Only_Numbers(ByVal KeyAscii As MSForms.ReturnInteger)
Here is a quick example that I created for you.
Let's say your userform looks like this
Now place this in a class module
Public WithEvents TextBoxEvents As MSForms.TextBox
Private Sub TextBoxEvents_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case Asc("0") To Asc("9")
Case Else
KeyAscii = 0
End Select
End Sub
Screenshot
And place this in the userform
Dim myTBs() As New Class1
Private Sub UserForm_Initialize()
Dim i As Integer, objControl As Control
For Each objControl In Me.Controls
If TypeOf objControl Is MSForms.TextBox Then
i = i + 1
ReDim Preserve myTBs(1 To i)
Set myTBs(i).TextBoxEvents = objControl
End If
Next objControl
Set objControl = Nothing
End Sub
Screenshot
Now try entering text/numbers in any of the textboxes :)
EDIT
#SiddharthRout Wow! Awesome Reply! it's almost like that, but i require that certain textboxes (not all) on the userform could have this restriction. I guess that if i do this Set myTBs(i).TextBoxEvents = quantity1 (Considering that quantity1 is a textbox) should work? – fjatp 6 mins ago
If TypeOf objControl Is MSForms.TextBox Then
Select Case objControl.Name
Case "TextBox1", "TextBox3", "TextBox4" '<~~ Include only these
i = i + 1
ReDim Preserve myTBs(1 To i)
Set myTBs(i).TextBoxEvents = objControl
End Select
End If

Preventing debugger when value is deleted from VBA textbox

My user form has several textbox's that can be edited by the user but it was reported to me that it was debugging. After a bit of investigation i found that the user was deleting the value out of the text box and this was causing a run-time error 13. How do i stop the run-time error if the user deletes the value and the servcredit textbox becomes a vbnullstring?
at present the text box has the 2 below pieces of code.
This inputs the numerical value into the excel sheets in the back.
Private Sub ServCredit_Change()
Worksheets("Calculator").Range("L18") = CDec(ServCredit)
End Sub
This ensure the user doesn't input a none numerical figure.
Private Sub ServCredit_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If (KeyAscii > 47 And KeyAscii < 58) Or KeyAscii = 46 Or KeyAscii = 32 Then
KeyAscii = KeyAscii
Else
KeyAscii = 0
MsgBox "Invalid Key Pressed"
End If
End Sub
You could simply test if there is a value:
Private Sub ServCredit_Change()
If Len(ServCredit.Text) <> 0 then
Worksheets("Calculator").Range("L18").Value2 = CDec(ServCredit)
Else
Worksheets("Calculator").Range("L18").Value2 = vbnullstring
end if
End Sub
You first need to check if ServCredit is numeric. CDec cannot cast a vbNullString into a number.
If IsNumeric(ServCredit) then
Worksheets("Calculator").Range("L18") = CDec(ServCredit)
else
Worksheets("Calculator").Range("L18") = 0
End If

VBA get amount of Time a key is pressed

I want to do a Makro with VBA which measures the amount of time the user presses a key, for example Space.
And when the user stops pressing it, the Time is stored and added to the time when the key is pressed again.
Im new to VBA and have some problems with the syntax. So I found the keyUP and keyDown functions here, but it seems that im using it the wrong way.
My code so far:
Sub KeyTime()
Time_old = 0
Range("A1").Value = Time_old
If Form_KeyDown(vbKeySpace, 0) Then
Start_time = Timer
If Form_KeyUp(vbKeySpace, 0) Then
End_time = Timer
Time = End_time - Start_time + Time_old
Time_old = Time
Range("A1").Value = Time_old
End If
End If
End Sub
The Userform's Key Events will not fire if a control has focus. You'll need either use a global variable or a Static method to track the key press.
Here I use a Static array variable inside a sub routine the track all the standard key presses.
Sub CountKeyPresses(KeyAscii As MSForms.ReturnInteger)
Static KeyCounts(255) As Long
If KeyAscii <= 255 Then
KeyCounts(KeyAscii) = KeyCounts(KeyAscii) + 1
Me.Caption = "Key(" & Chr(KeyAscii) & ") was pressed " & KeyCounts(KeyAscii) & " times"
End If
End Sub
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
CountKeyPresses KeyAscii
End Sub
Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
CountKeyPresses KeyAscii
End Sub

Check TextBoxes in Userform to make sure that they are integers

I'm trying to check my Userform when a command button is clicked to ensure that all the values entered in textboxes are integers. However, right now it's popping up with the message box even if I enter an integer value (i.e. 1 for all the textboxes).
Here's my code right now:
'Store inputs when clicking Continue
Private Sub Continue1_Click()
'Define variables
Dim Ctl As Control
For Each Ctl In CategoriesForm.Controls
If TypeName(Ctl) = "TextBox" Then
If IsNumeric(Ctl.Value) = True Then
If Int(Ctl.Value) <> Ctl.Value Then
MsgBox ("All inputs need to be integers for calculations to work. Please check the values."), vbCritical, "Error: Not All Inputs are Integers"
Exit Sub
End If
Else
MsgBox ("All inputs need to be integers for calculations to work. Please check the values."), vbCritical, "Error: Not All Inputs are Integers"
Exit Sub
End If
End If
Next
NumberClamps = Number_Clamps.Value
NumberBrackets = Number_Brackets.Value
NumberWashers = Number_Washers.Value
NumberScrews = Number_Screws.Value
NumberNuts = Number_Nuts.Value
NumberUNuts = Number_UNuts.Value
NumberRivets = Number_Rivets.Value
NumberStuds = Number_Studs.Value
Unload CategoriesForm
End Sub
Thanks
this is a sub that only allows user to enter numeric keys
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case vbKey0 To vbKey9
Case Else
KeyAscii = 0
Beep
End Select
End Sub
In conjunction with Doug Coats Solution
Create Class Module called "CTextboxes"
Option Explicit
Public WithEvents TextGroup As MSForms.TextBox
'Sub to allow users to only enter integer values
Private Sub TextGroup_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case vbKey0 To vbKey9
Case Else
KeyAscii = 0
Beep
MsgBox ("All inputs need to be integers for calculations to work. Please check the values."), vbCritical, "Error: All Inputs must be Integers"
End Select
End Sub
Put this code in the UserForm code module for when the USerForm initializes
Private Sub UserForm_Initialize()
'Stop user from entering non-integer values
Dim Ctl As MSForms.Control
Dim i As Long
i = 1
For Each Ctl In Me.Controls
If TypeName(Ctl) = "TextBox" Then
ReDim Preserve TextBoxes(1 To i)
Set TextBoxes(i).TextGroup = Ctl
i = i + 1
End If
Next Ctl
End Sub
Finally define this variable at the top of the UserForm Code
Option Explicit
Dim TextBoxes() As New CTextboxes

Making VBA Form TextBox accept Numbers only (including +, - and .)

I have simple textBox and I want to validate its input including "+" , "-" and "." here is what I have tried
Private Sub DisplayValue_TextBox_Change()
If Not IsNumeric(DisplayValue_TextBox.Value) Then
MsgBox "Only numbers allowed"
End If
End Sub
But this only accepts numbers 0-9 no negative, positive value or float value..
Further to my comment:
Consider a sample Userform1 with a Textbox1 and a CommandButton1
when you enter anything in the TextBox1 the change event fires - ie. typing one character fires the Change() event and passes the current value so even when you type in the negative sign your current logic fails.
What you need is to use another event like _AfterUpdate() or _Exit() with an amphasis on the second one because your can cancel the event :)
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsNumeric(TextBox1.Value) Then
MsgBox "only numbers allowed"
Cancel = True
End If
End Sub
You can find events here:
use the KeyPress event, and discard any non-numeric entry:
Private Sub txtShift1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Debug.Print KeyAscii
If KeyAscii >= 48 And KeyAscii <= 57 Then
Debug.Print "number"
Else
Debug.Print "other"
KeyAscii = 0
End If
End Sub
Having relied up till now on string parsing to do this job, I'm glad I decided to check and see how other people do it and found this Q.
I've refined Ruben Alvarez's excellent answer. The below will allow numerical entries only, and only one decimal point.
Private Sub txtShift1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case 46
If InStr(1, txtShift1, ".") > 0 Then KeyAscii = 0
Case 48 To 57
Case Else
KeyAscii = 0
End Select
End Sub
This could be further refined to allow only a single "+", "-" etc. as necessary.
I use this. It will allow only numbers with decimals.
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case vbKey0 To vbKey9, vbKeyBack, vbKeyClear, vbKeyDelete, _
vbKeyLeft, vbKeyRight, vbKeyUp, vbKeyDown, vbKeyTab
If KeyAscii = 46 Then If InStr(1, TextBox1.Text, ".") Then KeyAscii = 0
Case Else
KeyAscii = 0
Beep
End Select
End Sub
Im using that:
Private Sub txtGiaNet_Change()
If IsNumeric(txtGiaNet.Value) Then
//if number do sth
Else
//if not, delete this character
txtGiaNet.Value = Left(txtGiaNet.Value, Len(txtGiaNet.Value) - 1)
End If
End Sub
If TextBox1.Value <> "" Then
Dim N As Boolean
N = True
Do While N
If Not IsNumeric(TextBox1.Value) Then
TextBox1.Value = Left(TextBox1.Value, Len(TextBox1.Value) - 1)
Else
N = False
End If
Loop
End If
Private Sub TbCout_D_Edlp_Change()
Dim NotNumeric As Boolean
Dim TempValue As String
If Not IsNumeric(TbCout_D_Edlp.Value) Then
If TbCout_D_Edlp.Value <> "" Then
NotNumeric = True
MsgBox "Only numbers allowed"
TempValue = Left(Me.TbCout_D_Edlp.Value, Len(Me.TbCout_D_Edlp.Value) - 1)
While NotNumeric = True And TempValue <> ""
If Not IsNumeric(TempValue) Then
TempValue = Left(TempValue, Len(TempValue) - 1)
Else
NotNumeric = False
End If
Wend
Me.TbCout_D_Edlp.Value = TempValue
End If
End If
End Sub