I am trying to implement a find function in a userform in a textbox.
Once it detects that 4 digits have been input it looks for this value in a list of models in range ("C39:C102").
It returns the value of the cell that is two cells to the left of it (that's where the name of the group that the model number belongs to is stored), and changes the combobox to select that group automatically.
In the range ("C39:C102"), there are multiple model numbers per individual cell, as in:
C39= 9070, 4835, 2858, 2853
C40= 2374, 2737, 8857, 9895
etc.
The macro runs the first time after opening the Excel sheet but when I look for a second model number it goes to "not found".
Private Sub TextBox5_Change()
'when user inputs a model number automatically change the combo box below it to correct group
Dim rng1 As Range
Dim modelNum As String
If Len(TextBox5.Text) = 4 Then
modelNum = TextBox5.Value
Set rng1 = Range("C39:C102").Find(modelNum)
If Not rng1 Is Nothing Then
ComboBox1.Value = rng1.Offset(0, -2)
MsgBox "This tool (" & modelNum & ") belongs to " & rng1.Offset(0, -2) & " group."
Else
MsgBox modelNum & " not found"
End If
TextBox5.Value = ""
modelNum = ""
Set rng1 = Nothing
'ComboBox1.Value = ""
End If
End Sub
Your code works fine for me.
Instead of this:
Set rng1 = Range("C39:C102").Find(modelNum)
try being a bit more explicit:
Set rng1 = Range("C39:C102").Find(What:=modelNum, Lookin:=xlValue, LookAt:=xlWhole)
Find() settings in excel are "sticky" and unless you specify them explicitly you'll get whatever settings were last-used.
Related
I already have a barcode scanner VBA function, that recognizes the barcode number, but the problem I have is that I have to click enter every time, is there any way to do it automatically and store the count in a certain column? Currently it works if I enter the same value stored in column B, it will count the records in column C, but I want to avoid hitting enter every time
This is what I got so far
Private Sub btnAdd_Click()
Dim TargetCell As Range
If WorksheetFunction.CountIf(Sheets("Sheet1").Columns(2), TextBox1.Value) = 1 Then
Set TargetCell = Sheets("Sheet1").Columns(2).Find(TextBox1.Value, , xlValues, xlWhole).Offset(0, 1)
TargetCell.Value = TargetCell.Value + 1
Else
MsgBox "Code not found"
End If
Me.Hide
End Sub
It's hard to say what you have. For example, who presses the button? Or, does your scanner enter a return. I think the code below should work under any circumstances. Please try it.
Private Sub TextBox1_Change()
Dim TargetCell As Range
Dim Qty As Long
With TextBox1
If Len(.Value) = 3 Then
Set TargetCell = Worksheets("Sheet1").Columns(2) _
.Find(.Value, , xlValues, xlWhole)
If TargetCell Is Nothing Then
MsgBox """" & .Value & """ Code not found"
Else
With TargetCell.Offset(0, 1)
Qty = .Value + 1
.Value = Qty
End With
Application.EnableEvents = False
TextBox1.Value = "Count = " & Qty
Application.EnableEvents = True
End If
.SelStart = 0
.SelLength = Len(.Value)
End If
End With
End Sub
I think you have a user form and in this form you have a text box called TextBox1. If so, the code should be in the user form's code module. If you have a text box in your worksheet paste the code to the code module of the sheet on which the text box resides.
Now, you need to adjust this line of code If Len(.Value) = 3 Then to determine when to process the data. This is because the Change event will occur whenever even a single character is entered. I tested with 3 characters. Change the number to a value equal to the length of the numbers you scan in. In theory that still leaves the CR hanging which your scanner might also send. If that causes a problem experiment with >= in place of the = in my code.
The code will add the scan to the existing quantity, just as you had it, and indicate the new total in the text box, in case you are interested. You might replace this with "OK". The code will select the text it enters. Therefore when you enter something else, such as a new scan, it will be over-written without extra clicks being required.
I'm attempting to create a form for data entry of lab results, which validates an answer based on the specification of the product tested. The user enters the following information: Product Code and SG result etc
My source data is a table with 4 columns,
Product Code, Description, SG low, SG high
SOURCE
When the user enters the Product Code and SG in the form I would like it to validate based on the specific range allowed for that product (from the source data), and have a dialogue box asking the user to reconsider the result entered (if it were outside of the range).
Easy enough to flag with conditional formatting in the results sheet, but I don't want my users to have access to it.
RESULTS
I need to refer to separate Range VLOOKUP to return the specs.
THE FORM
Thanks in advance!
(update)
Private Sub CommandButton1_Click()
Dim i As Integer
i = 2
While ThisWorkbook.Worksheets("Sheet2").Range("A" & i).Value <> ""
i = i + 1
Wend
Dim losg, loph, hisg, hiph As Double
losg = Application.WorksheetFunction.VLookup(ProdCode.Text, Sheet1.Range("A1:F24"), 3, False)
hisg = Application.WorksheetFunction.VLookup(ProdCode.Text, Sheet1.Range("A1:F24"), 4, False)
loph = Application.WorksheetFunction.VLookup(ProdCode.Text, Sheet1.Range("A1:F24"), 5, False)
hiph = Application.WorksheetFunction.VLookup(ProdCode.Text, Sheet1.Range("A1:F24"), 6, False)
If SGresult.Text < losg Then
MsgBox "SG result " & SGresult.Text & " too low"
ElseIf SGresult.Text > hisg Then
MsgBox "SG result " & SGresult.Text & " too high"
Else: MsgBox "SG result " & SGresult.Text & " just right"
End If
If pHresult.Text < loph Then
MsgBox "ph result " & pHresult.Text & " too low"
ElseIf pHresult.Text > hiph Then
MsgBox "ph result " & pHresult.Text & " too high"
Else: MsgBox "ph result " & phresult.Text & " just right"
End If
ThisWorkbook.Worksheets("Sheet2").Range("A" & i).Value = ProdCode.Value 'Enter Code in Column A
ThisWorkbook.Worksheets("Sheet2").Range("C" & i).Value = BNenter.Value 'Enter BN in Column C
ThisWorkbook.Worksheets("Sheet2").Range("D" & i).Value = DOMenter.Value 'Enter DOM in Column D
ThisWorkbook.Worksheets("Sheet2").Range("E" & i).Value = SGresult.Value 'Enter SG result in Column E
ThisWorkbook.Worksheets("Sheet2").Range("F" & i).Value = pHresult.Value 'Enter pH result in Column F
ThisWorkbook.Worksheets("Sheet2").Range("K" & i).Value = BatcherID.Value 'Enter Batcher ID in Column K
End Sub
Save Products in column "K" and valid result for respective product in column "L". Below code will give you desired output
Dim result, prod As String
Dim rng As Range
result = Val(resultText.Value)
prod = prodText.Value
ActiveSheet.Activate
On Error GoTo step:
Set rng = Range("K:K").Find(What:=prod, LookIn:=xlValues, LookAt:=xlWhole)
If rng.Offset(0, 1).Value <> result Then
MsgBox "The result entered is out of valid range!"
End If
Exit Sub
step:
MsgBox "Invalid Product"
Exit Sub
edited after OP clarified the "form" was a "UserFom"
You may want to check user input while he/she's editing/exiting any control instead of waiting for the CommandButton1_Click event and check them all together
Such a "modular" approach should keep code more easy to control and maintain
For example the TextBox Exit event could be used to check the user input as he/she's leaving it and have him/her come back to it in case of wrong input
Moreover
since "Product Code" must be chosen between those listed in "Source" worksheet column "A"
you may want to use a ComboBox control and have the user choose one out of a list
since "Product Name" must be the one corresponding to the chosen "Product Code"
you may want to use a Label control and have the user simply looks at what name corresponds to the product code he just chose
Following what above and assuming "ProductNameLbl" as the label name, your userform code could be something like follows:
Option Explicit
Private Sub UserForm_Initialize()
Me.ProdCodeCB.List = GetSourceData(1) '<--| fill Product Name combobox list with "Source" worksheet column 1 data
End Sub
Private Sub ProdCodeCB_Change() '<--| fires when the user change the combobox selection
Me.ProdNameLbl.Caption = Worksheets("Source").Cells(Me.ProdCodeCB.ListIndex + 2, 2) '<--| update Product Name label with the name corresponding to the chosen Product Code
End Sub
Private Sub SGresultTB_Exit(ByVal Cancel As MSForms.ReturnBoolean) '<--| fires upon exiting the SGresult textbox
Dim msgErr As String
With Me '<--| reference the Userform
If .ProdCodeCB.ListIndex <> -1 Then '<--| if a valid selection has been made in 'ProductCode' combobox
If Not IsValueInRange(.SGresultTB, GetProdCodeRange(.ProdCodeCB.ListIndex + 1), msgErr) Then '<-- if value out of range then...
With .SGresultTB
MsgBox "SG value " & .Value & msgErr _
& vbCrLf & vbCrLf & "Please reconsider the value you input in 'SG' texbox"
Cancel = True
.SetFocus '<--| get the user back to the textbox
' following two lines select the textbox text so that the user can delete it
.SelStart = 0
.SelLength = Len(.Text)
End With
End If
End If
End With
End Sub
'-------------------------------------------------
' helper functions
'---------------------------
Function GetSourceData(colIndex As Long)
' this function returns an array with "Source" worksheets data in passed column from its row 2 to last not empty one
With Worksheets("Source") '<--| reference "Source" worksheet
GetSourceData = Application.Transpose(.Range(.Cells(2, colIndex), .Cells(.Rows.Count, colIndex).End(xlUp)).Value)
End With
End Function
Function IsValueInRange(tb As MSForms.TextBox, rangeArr As Variant, msgErr As String) As Boolean
' this function returns a boolean (true/false) with the result of the checking whether the passed texbox (tb) text exceeds the passed range (rangeArr)
' msgErr is also set to some text if the range is exceeded
With tb
Select Case CDbl(.Value) '<-- prepare to act accordingly to its value
Case Is < rangeArr(1) '<--| if it's smaller than "SG Low" value
msgErr = " is lower than 'SG Low' = " & rangeArr(1) '<-- build the final part of the error message correspondingly
Case Is > rangeArr(2) '<--| while if it's greater than "SG High" value
msgErr = " is greater than 'SG High' = " & rangeArr(2) '<-- build the final part of the error message correspondingly
End Select
End With
IsValueInRange = msgErr = ""
End Function
Function GetProdCodeRange(iProd As Long)
' this function returns an array of the SG minimum and maximum values in "Source" worksheet corresponding to the chosen product
With Worksheets("Source") '<--| reference "Source" worksheet
With .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)) '<--| reference its column "A" cels from row 2 down to last not empty one
GetProdCodeRange = Application.Transpose(Application.Transpose(.Cells(iProd, 1).Offset(, 2).Resize(, 2).Value)) '<--| return an array with "SG low" and "SG high" values corresponding to the product index passed
End With
End With
End Function
'-------------------------------------------------
as you may see, I named controls after the names you chose for them except for adding a suffix to tell what kind of control they are:
ProdCodeCB: "CB" -> it's a ComboBox control name
SGresultTB: "TB" -> it's a TextBox control name
ProdNameLbl: "Lbl" -> it's a Label control name
I want to use the .find function in VBA to find instances of a value in a column, however there are calculations which are made based on criteria on the same rows as where the value is found. This is problematic because although the value I am looking for might be the same, the criteria which are used to create the overall score are different. As a result, I would need to loop through all the values which are found in the column and I was wondering how to do that in vba. I know the findnext function but I can never get it to work properly.
counted = Application.WorksheetFunction.CountIfs(cl.Range(finletter & "9:" & finletter & "317"), "Value", cl.Range("H9:H317"), wl.Range("A" & y.row).Value)
'Pol small low complex
If counted > 0 Then
MsgBox wl.Range("A" & y.row).Value
If cl.Range("C" & y.row).Value < 3 And cl.Range("D" & y.row).Value = 1 And cl.Range("E" & y.row).Value = "Interim" Then
wl.Range(y.Address) = 3.75 * counted
Here is an example. Say we are looking for the text "LOVE" in column A and process the data on those rows:
Option Base 1
Sub LookingForLove()
Dim s As String, rng As Range, WhichRows() As Long
Dim rFound As Range
ReDim WhichRows(1)
s = "LOVE"
Set rng = Range("A1:A25")
Set rFound = rng.Find(What:=s, After:=rng(1))
WhichRows(1) = rFound.Row
Do
Set rFound = rng.FindNext(After:=rFound)
If rFound.Row = WhichRows(1) Then Exit Do
ReDim Preserve WhichRows(UBound(WhichRows) + 1)
WhichRows(UBound(WhichRows)) = rFound.Row
Loop
msg = UBound(WhichRows) & vbCrLf & vbCrLf
For i = 1 To UBound(WhichRows)
msg = msg & WhichRows(i) & vbCrLf
Next i
MsgBox msg
End Sub
NOTE:
the Exit Do prevents looping forever
your code would continue by looping the elements of WhichRows() and processing the items on those rows.
your code could alternatively create a dynamic array of ranges or cell addresses.
Another alternative approach would be to use VBA to establish an AutoFilter and process the visible rows.
I want to code a program that compares two columns in two sheets. The user will input the sheet names and ranges he/she wants to compare. If data are found in both sheets the first sheet will highlight the cells in green indicating that the value is available in the other sheet.
When I run the code it gives a run time '9' error: subscript is out of range
Note: When I run the code by entering the sheet name in the code instead of using the text box, it runs the program successfully.
Private Sub FindBtn_Click()
MsgBox (fromSheetTxtBox) ' it outputs the sheet name
'MsgBox (fromRangeFromTxtBox)
'MsgBox (fromRangeToTxtBox)
'MsgBox (toSheetTxtBox)
'MsgBox (ToRangefromTxtBox)
'MsgBox (ToRangeToTxtBox)
'Dim toSheet As String
'Set toSheet = toSheetTxtBox.Value
Dim i As Integer
For i = 8 To 9331
Set cell = Worksheets(fromSheetTxtBox.Text).range("D8:D1427").Find(What:=Worksheets(toSheetTxtBox.Text).Cells(i, 2), lookat:=xlWhole)
If Not cell Is Nothing Then ' if jde cell value is found in tops then green jde cell
Worksheets("toSheetTxtBox").Cells(i, 2).Interior.ColorIndex = 4
End If
Application.StatusBar = "Progress: " & i & " of 9331 " '& Format(i / 9331, "%")
Next i
End Sub
If toSheetTxtBox is a TextBox, change this line:
Worksheets("toSheetTxtBox").Cells(i, 2).Interior.ColorIndex = 4
to this:
Worksheets(toSheetTxtBox).Cells(i, 2).Interior.ColorIndex = 4
Good Day,
really need some help here, im bad at VBA.
Had created a spreadsheet and recorded a macro to record checkin of staff. However, im having difficulties checking out with the corresponding users based on the name.
Could anyone help me out over here?
Thanks. Had attached the spreadsheet for your ref.
http://www.etechnopia.com/vish/Book1ss.xlsm
After much googling, This is what i did based on mikes solution
Dim name As String
Dim id As Integer
Dim checkin As Date
Dim checkout As Date
name = Range("d6").Value
id = Range("d7").Value
checkin = Now
Range("d10") = checkin
Help anyone? im my very best here.
firstly I recommend to use range names for the important cells of your sheet
D6 EmpName
D7 EmpNo
D10 ClockInTime
D11 ClockOutTime
H5..H11 DataTable
This will enable you to reference them by name instead of hardcoding their addresses (bad bad hardcoding :-/ )
Secondly, your [Button] must serve a dual purpose ... it has to decide if a user is clocked in or out and do different things
a hi-level META code, executed at pressing [Button4] could be
if user clocked in
write current time into ClockOutTime ' remark: this may be superfluous
find DataTable record (EmpName, ClockInTime)
write ClockOutTime into record (EmpName, ClockInTime)
erase EmpName, EmpID, ClockInTime, ClockOutTime
else
write current time into ClockInTime
find first blank record in DataTable
write EmpName, EmpID, ClockInTime into DataTable record
endif
How to decide if a user is clocked in? If many users are using the same sheet at the same time (meaning 5 emps go there, write in their names and clock in) you need to examine DataTable for the first record of EmpNane without a ClockOutTime - if found he/she is in and needs to be clocked out.
more later ...
OK ... sorry was interrupted by Lady Gaga concerto in Vienna/AT
so here's a full code for the button
Sub ButtonPressed()
Dim DB As Range, Idx As Integer
Set DB = Range("DataTable")
If Range("EmpName") = "" Or Range("EmpNo") = "" Then
MsgBox "Enter your name and ID before pressing the button", vbCritical + vbOKOnly, "missing input"
Exit Sub
End If
Idx = UserClockedIn()
If Idx <> 0 Then
DB(Idx, 4) = Date + Time()
DB(Idx, 5).Formula = "=" & DB(Idx, 4).Address(RowAbsolute:=False, ColumnAbsolute:=False) & "-" & DB(Idx, 3).Address(RowAbsolute:=False, ColumnAbsolute:=False)
DB(Idx, 5).NumberFormat = "[hh]:mm"
Range("EmpName") = ""
Range("EmpNo") = ""
Else
Idx = 2
Do While DB(Idx, 1) <> ""
Idx = Idx + 1
Loop
DB(Idx, 1) = Range("EmpName")
DB(Idx, 2) = Range("EmpNo")
DB(Idx, 3) = Date + Time()
End If
End Sub
Private Function UserClockedIn() As Integer
Dim DB As Range, Idx As Integer
Set DB = Range("DataTable")
UserClockedIn = 0
Idx = 2
Do While DB(Idx, 1) <> ""
If DB(Idx, 1) = Range("EmpName") And DB(Idx, 2) = Range("EmpNo") And DB(Idx, 4) = "" Then
UserClockedIn = Idx
Exit Function
End If
Idx = Idx + 1
Loop
End Function
#user502908: I have not documented it because I want you to find out exactly what it does and by that have a quick start into Excel-VBA :-) It doesn't do too much and there are some basic thechniques you will apply again & again if you go into VBA ... try to populate ranges "ClockInTime" and "ClockOutTime" :-)))
Book1ssNew.xlsm
have fun
I tried another simpler method which i could cope with
Sub yes()
Dim findId As Integer
Dim FirstAddress As String
Dim FindString As Integer
Dim Rng As Range
FindString = Range("d7").Value
If Trim(FindString) <> "" Then
With Sheets("Sheet1").Range("F1:J100")
Set Rng = .find(What:=FindString, _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, True
FirstAddress = Rng.Address
Rng.Offset(0, 2).Value = Now()
Else
MsgBox "Nothing found"
End If
End With
End If
End Sub
Search entire spreadsheet given id, when id found, to indicate dynamically the checkin timing.