I am trying to have a userform search a worksheet for the specific specimen_ID (column AV) and report back items in Columns (T, S, and W). Preferably, these items would show up in a message box after clicking verify patient info (command button). If these match on the physical test item, then the user would need to update the test result from a Combobox which updates info in column AS.
I'm having difficulty finding the correct coding to use. I initially thought to just have the verified patient info pop-up as a message box instead of using text boxes, but I wasn't sure how to input match and index functions into the VBA coding. And I also am not sure how to use match/index in this scenario. I know that Vlookup only works when searching to the right.
Example workbook with the VBA user forms and coding https://www.filedropper.com/dummytest
Here's the whole code for that user form.
Private Sub CBResult_Enter()
Me.CBResult.Clear
Me.CBResult.AddItem "Detected/Positive"
Me.CBResult.AddItem "Not detected/Negative"
Me.CBResult.AddItem "Inconclusive/Undetermined/Invalid/Equivocal"
End Sub
Private Sub CmdB_Results_Verify_Click()
Dim specimen_id As String
specimen_id = Trim(Txt_Results_SpecimenID.Text)
lastrow = Worksheets("Entry").Cells(Rows.Count, "AV").End(xlUp).Row
For i = 2 To lastrow
If Worksheets("Entry").Cells(i, 1).Value = specimen_id Then
Txt_Results_FName = Worksheets("Entry").Cells(i, "T").Value
Txt_Results_LName = Worksheets("Entry").Cells(i, "S").Value
Txt_Results_DOB = Worksheets("Entry").Cells(i, "W").Value
End If
Next
End Sub
Private Sub CmdBResult_Save_Click()
'copy values to sheet.
Dim Result As String
Result = CBResult.Value
lastrow = Worksheets("Entry").Cells(Rows.Count, "AV").End(xlUp).Row
For i = 2 To lastrow
If Worksheets("Entry").Cells(i, 1).Value = Txt_Results_specimen_id.Value Then
Worksheets("Entry").Cells("AS").Value = CBResult.Value
'Clear input Controls.
Me.CBResult.Value = ""
Txt_Results_FName.Value = ""
Txt_Results_LName.Value = ""
Txt_Results_DOB.Value = ""
End Sub
Private Sub CmdB_Results_Close_Click()
'Close "ResultsEntry"
Unload Me
End Sub
The fewer text boxes I have here the better.
I have updated your code to do what I believe you are wanting. I will paste the entire code so you can just put the whole thing back into your userform code.
Please note:
Private Sub CmdBResult_Save_Click()
when it should've been this: Private Sub CmdB_Results_Save_Click()
Application.Match
to find the match instead of looping. This will work should there only be one match you need to update. If you need to for some reason find duplicates etc then it would need to change to use either .Find
or loop.FindResult
as a public variable so that the Specimen ID doesn't have to be found twice (once to get the patient details and again to update the test result).Let me know if there is something wrong with it but it should work. I've tested it all.
Public FindResult As Double
Private Sub CBResult_Enter()
Me.CBResult.Clear
Me.CBResult.AddItem "Detected/Positive"
Me.CBResult.AddItem "Not detected/Negative"
Me.CBResult.AddItem "Inconclusive/Undetermined/Invalid/Equivocal"
End Sub
Private Sub CmdB_Results_Verify_Click()
Dim specimen_id As Double
'Check something has been enetered in SpecimenID
If Len(Txt_Results_SpecimenID.Text) = 0 Then
Exit Sub
End If
FindResult = 0
specimen_id = Txt_Results_SpecimenID.Text
On Error Resume Next
FindResult = Application.Match(specimen_id, Sheets("Entry").Range("AV:AV"), 0) 'Find the matching ID
If FindResult > 0 Then 'FindResult will be greater than 0 if match found. It will be the row that it found it on.
Txt_Results_FName.Text = Worksheets("Entry").Range("T" & FindResult).Value
Txt_Results_LName.Text = Worksheets("Entry").Range("S" & FindResult).Value
Txt_Results_DOB.Text = Worksheets("Entry").Range("W" & FindResult).Value
Else
MsgBox "No matching Specimen ID was found.", vbInformation, "No Result"
Me.CBResult.Value = ""
Txt_Results_FName.Value = ""
Txt_Results_LName.Value = ""
Txt_Results_DOB.Value = ""
End If
End Sub
Private Sub CmdB_Results_Save_Click()
'copy values to sheet.
Dim Result As String
If Len(Txt_Results_SpecimenID.Text) = 0 Then
MsgBox "There is no Specimen ID entered. The patient info cannot be updated without this identifier.", vbExclamation, "Please enter Specimen ID"
Exit Sub
ElseIf FindResult = 0 Then
MsgBox "The Specimen ID has not been searched for. Please do this before trying to update the patient info.", vbExclamation, "Please enter Specimen ID"
Exit Sub
ElseIf CBResult.Value = "" Then
MsgBox "Please select a test result from the options.", vbExclamation, "Select a test result"
Exit Sub
End If
Worksheets("Entry").Range("AS" & FindResult).Value = CBResult.Value
'Clear input Controls.
Me.CBResult.Value = ""
Txt_Results_FName.Value = ""
Txt_Results_LName.Value = ""
Txt_Results_DOB.Value = ""
End Sub
Private Sub CmdB_Results_Close_Click()
'Close "ResultsEntry"
Unload Me
End Sub
Private Sub Txt_Results_SpecimenID_Change()
Dim ID As String
ID = Txt_Results_SpecimenID.Text
'This will only allow numbers to be entered into the Specimen ID box
If Not IsNumeric(Right(ID, 1)) Then
If Len(ID) = 0 Then Exit Sub
Txt_Results_SpecimenID.Text = Left(ID, Len(ID) - 1)
End If
End Sub