I have data in a delimited text file containing list of items and their relationship with each other, as shown below
Data set text file
where each Item Id is distinct and parent wbs column shows the relationship with parent items.
i am able to import the above data to excel, but unable to figure out how to structure them in tree format in excel and also make sure that under each node the items are sorted again by their sequence numbers
For i = 3 To LastRow
Dim found As Boolean = False
For k = 2 To wbssht.UsedRange.Rows.Count
If wbssht.Cells(k, 1).value = sht.Cells(i, 3).value Then
wbssht.Rows(k + 1).insert
wbssht.Cells(k + 1, 1).value = sht.Cells(i, 1).value
wbssht.Cells(k + 1, 3).value = wbssht.Cells(k, 3).value + 2
wbssht.Cells(k + 1, 2).value = Space(wbssht.Cells(k + 1, 3).value) & sht.Cells(i, 2).value
wbssht.Cells(k + 1, 4).value = sht.Cells(k, 3).value 'parentwbs
wbssht.Cells(k + 1, 5).value = sht.Cells(k, 4).value 'sequence
found = True
Exit For
End If
Next
If found = False Then
wbssht.Cells(wbssht.UsedRange.Rows.Count + 1, 1).value = sht.Cells(i, 1).value
wbssht.Cells(wbssht.UsedRange.Rows.Count, 2).value = sht.Cells(i, 2).value
wbssht.Cells(wbssht.UsedRange.Rows.Count, 3).value = 0
wbssht.Cells(wbssht.UsedRange.Rows.Count, 4).value = sht.Cells(i, 3).value
wbssht.Cells(wbssht.UsedRange.Rows.Count, 5).value = sht.Cells(i, 4).value
End If
Next
I am trying to achieve an indented output structure as image below in excel.
Expected output
I know its probably really simple, but may need some different approach.
Try this code:
Private Sub TreeView1_KeyUp(KeyCode As Integer, ByVal Shift As Integer)
'Checking what button is pressed.
Select Case KeyCode
'If F5 is pressed.
Case Is = 116
'Declarations.
Dim RngList As Range
Dim RngTarget As Range
Dim DblNameOffset As Double
Dim DblParentOffset As Double
Dim DblSequenceOffset As Double
Dim StrMarker As String
Dim NodNode As Node
Dim DblRow As Double
Dim DblCounter01 As Double
Dim DblItemMax
Dim ObjTreeView As Object
'Setting RngList as the first value in the Item ID column.
Set RngList = Sheets("Sheet1").Range("A2")
'Setting ObjTreeView.
Set ObjTreeView = ActiveSheet.Shapes("TreeView1")
'Setting StrMarker as a value that won't be in any Item ID value nor in any Sequence value.
StrMarker = " | "
'Setting the variables as offests of each column of data from the Item ID column.
DblNameOffset = 1
DblParentOffset = 2
DblSequenceOffset = 3
'Changing RngList to cover the whole Item ID list.
Set RngList = RngList.Parent.Range(RngList, RngList.End(xlDown))
'Setting DblItemMax as the count of Item IDs.
DblItemMax = Excel.WorksheetFunction.CountA(RngList)
'Checking that RngList does not contain any non unique value, non numeric value, blank cell.
For Each RngTarget In RngList
Select Case True
Case Is = (Excel.WorksheetFunction.CountIf(RngList, RngTarget.Value) > 1)
MsgBox "Non unique item ID found. The treeview will not be updated.", vbCritical + vbOKOnly, "Invalid item ID: " & RngTarget.Value
Exit Sub
Case Is = (RngTarget.Value = "")
MsgBox "Blank ID found. The treeview will not be updated.", vbCritical + vbOKOnly, "Invalid item ID in cell " & RngTarget.Address(False, False)
Exit Sub
Case Is = (IsNumeric(RngTarget.Value) = False)
MsgBox "Non numeric item ID found. The treeview will not be updated.", vbCritical + vbOKOnly, "Invalid item ID: " & RngTarget.Value
Exit Sub
End Select
Next
'Clearing ObjTreeView of any previous nodes.
ObjTreeView.OLEFormat.Object.Object.Nodes.Clear
'Covering each Item ID from the smalles to the greatest.
For DblCounter01 = 1 To DblItemMax
'Setting DblRow as the number of row in RngList that contains the given Item ID.
With Excel.WorksheetFunction
DblRow = .Match(.Small(RngList, DblCounter01), RngList, 0)
End With
'Setting RngTarget as the cell that contains the given Item ID.
Set RngTarget = RngList.Cells(DblRow, 1)
'Checking if the given parent name exist in RngList.
If Excel.WorksheetFunction.CountIf(RngList, RngTarget.Offset(0, DblParentOffset).Value) = 0 Then
'If it doesn't exist, the new node is added with no parent node.
ActiveSheet.Shapes("TreeView1").OLEFormat.Object.Object.Nodes.Add , , "K" & RngTarget.Value, RngTarget.Offset(0, DblSequenceOffset) & StrMarker & RngTarget.Offset(0, DblNameOffset)
Else
'If it exists, the new node is added under its parent node.
ActiveSheet.Shapes("TreeView1").OLEFormat.Object.Object.Nodes.Add "K" & RngTarget.Offset(0, DblParentOffset), tvwChild, "K" & RngTarget.Value, RngTarget.Offset(0, DblSequenceOffset) & StrMarker & RngTarget.Offset(0, DblNameOffset)
End If
Next
'Sorting each node (they were added with the Sequence value at the beginning of it text).
For Each NodNode In ActiveSheet.Shapes("TreeView1").OLEFormat.Object.Object.Nodes
NodNode.Sorted = True
Next
'Cutting out the sequence value from the text of each node using the properly placed StrMarker.
For Each NodNode In ActiveSheet.Shapes("TreeView1").OLEFormat.Object.Object.Nodes
NodNode.Text = Split(NodNode.Text, StrMarker)(1)
Next
End Select
End Sub
It's a private sub that will activate when you press F5 while the treeview is selected. Therefore you'll have to place it in the module of the sheet where the treeview is located. It assumes that your treeview is named TreeView1. It also assumes that your list is placed in the cells A1 of a sheet named Sheet1; that means that in cell A1 of Sheet1 you'll find the header "Item ID" while in cell A2 you'll find the first ID. Note that you can have the list in one sheet and the treeview in another one. Anyway you can edit the code itself accordingly to your needs (perhaps you can change the list address, the treeview name or the key to be pressed to activate it). Other paramaters can also be costumized.
The code checks for any empty, non numeric non unique Item ID and if it finds any of them it terminates itself.
The list can be sorted in any order. The code should work anyway. In your data sample the first item (27521) has a parent name (18133) with no match in the Item ID column. In case like this, the code create a node with no parent node. In any case it is assumed that any Item ID has a father with a lower Item ID.
Related
I have a User Form that searches a table column and returns all the values in the row as editable fields on the form. It works fantastic! But I wanted to add another column to the search. I would like to use the last 4 numbers of an 11 digit number so I created another column with a formula that returns the last 4 digits.
I set the variable with:
RecordRow = Application.Match(CLng(TextBoxSearch.Value), Range("JobSheet[W/O]"), 0).
and it works fine. The column is filled with 6 digit numbers populated by this reference: =IFERROR(JobSheetData[#[W/O]],"").
However, when I change it to this:
RecordRow = Application.Match(CLng(TextBoxSearch.Value), Range("JobSheet[Ticket Search]"), 0)
it will not find the row with the search value.
I have a column in the table that uses this reference =IFERROR(JobSheetData[#[ON1Call Ticket '#]],"") and then I have the column Ticket Search that contains the last 4 digits as mentioned above.
The W/O column that is searchable has every line filled with data but 40% of the Ticket Search column is blank. I tried removing values from the W/O column to see if that was the issue but it still worked.
Here is all the code:
Private Sub CommandButton1_Click()
Dim RecordRow As Long
Dim RecordRange As Range
Dim sChkBoxResult As String
' Turn off default error handling so Excel does not display
' an error if the record number is not found
On Error Resume Next
'Find the row in the table that the record is in
**This one works:**
RecordRow = Application.Match(CLng(TextBoxSearch.Value), Range("JobSheet[W/O]"), 0)
**This one doesn't:**
RecordRow = Application.Match(CLng(TextBoxSearch.Value), Range("JobSheet[Ticket Search]"), 0)
' Set RecordRange to the first cell in the found record
Set RecordRange = Range("JobSheet").Cells(1, 1).Offset(RecordRow - 1, 0)
' If an erro has occured i.e the record number was not found
If Err.Number <> 0 Then
ErrorLabel.Visible = True
On Error GoTo 0
Exit Sub
End If
' Turn default error handling back on (Let Excel handle errors from now on)
On Error GoTo 0
' If the code gets to here the record number was found
' Hide the error message 'Not Found'
ErrorLabel.Visible = False
' and populate the form fields with the record's data
TextBoxNameAddress.Value = RecordRange(1, 1).Offset(0, 3).Value & " - " & RecordRange(1, 1).Offset(0, 2).Value & " " & RecordRange(1, 1).Value
TextBoxHold.Value = RecordRange(1, 1).Offset(0, 5).Value
TextBoxDays.Value = RecordRange(1, 1).Offset(0, 7).Value
CheckBoxLocate.Value = RecordRange(1, 1).Offset(0, 9).Value
TextBoxCount.Value = RecordRange(1, 1).Offset(0, 11).Value
TextBoxFirst.Value = RecordRange(1, 1).Offset(0, 13).Value
TextBoxOveride.Value = RecordRange(1, 1).Offset(0, 14).Value
CheckBoxBell.Value = RecordRange(1, 1).Offset(0, 15).Value
CheckBoxGas.Value = RecordRange(1, 1).Offset(0, 16).Value
CheckBoxHydro.Value = RecordRange(1, 1).Offset(0, 17).Value
CheckBoxWater.Value = RecordRange(1, 1).Offset(0, 18).Value
CheckBoxCable.Value = RecordRange(1, 1).Offset(0, 19).Value
CheckBoxOther1.Value = RecordRange(1, 1).Offset(0, 20).Value
CheckBoxOther2.Value = RecordRange(1, 1).Offset(0, 21).Value
CheckBoxOther3.Value = RecordRange(1, 1).Offset(0, 22).Value
End Sub
UPDATE:
Here is a screenshot of some sample data:
The data starts in column A
My ultimate goal was to have an if statement that would run either the 6 digit search on the W/O column or the 4 digit search on the ON1Call Ticket # column based on the length of the string in TextBoxSearch Since they are either 4 digit or 6 digit, I thought I would base it on if the value was >9999 but the `ON1Call Ticket #' column is a text column and not numeric and the search fails.
When the first utility locate arrives the 10 or 11 digit ticket number is automatically added to the Job Sheet. As the emails arrive from the various utilities, the ticket number is always used for identification. I have an automation that extracts the Ticket number and saves the incoming locates as PDF files using the ticket number and some random characters characters as the file name. I have it set up to split the filename like this: 123456 7890 - jkes.pdf. A person now renames the file to indicate what utilities are included in that file and and uses the middle set of 4 numbers in the User Form:
to find the correct record and check the checkbox of the corresponding utility. I don't want the user to have to type all 11 digits and I was trying to avoid a helper column but I could not figure out how to make the 4 digit search look only at the last 4 digits of the ticket number.
At other times we need to search by the Work Order # which is 6 digits.
I would maybe do something like this:
Private Sub CommandButton1_Click()
Dim RecordRow As Variant '<<< not Long, or throws an error when no match
Dim vSearch As Long, col, lo As ListObject
Set lo = ThisWorkbook.Worksheets("Data").ListObjects("JobSheet") 'adjust sheet name
vSearch = CLng(TextBoxSearch.Value)
For Each col In Array("W/O", "Ticket Search") 'loop over columns to search in
'no need for On Error Resume Next - test the return value from Match instead
RecordRow = Application.Match(vSearch, lo.ListColumns(col).DataBodyRange, 0)
If Not IsError(RecordRow) Then Exit For 'got a hit - stop searching
Next col
ErrorLabel.Visible = IsError(RecordRow) 'hide/show error label
If Not IsError(RecordRow) Then LoadRecord lo.ListRows(RecordRow).Range
End Sub
EDIT: after clarification - different search methods depending on length of input
Private Sub CommandButton1_Click()
Dim RecordRow As Variant '<<< not Long, or throws an error when no match
Dim vSearch, col, lo As ListObject
Set lo = ThisWorkbook.Worksheets("Data").ListObjects("JobSheet") 'adjust sheet name
vSearch = TextBoxSearch.Value
If Not IsNumeric(vSearch) Then
MsgBox "Search value must be numeric!"
End If
'decide how to search based on length of search input
Select Case Len(vSearch)
Case 4
'call custom function instead of Match
RecordRow = EndsWithMatch(vSearch, lo.ListColumns("ON1Call Ticket #").DataBodyRange)
Case 6
'cast search value to Long before using Match
RecordRow = Application.Match(CLng(vSearch), lo.ListColumns("W/O").DataBodyRange, 0)
Case Else
MsgBox "Search value must either 4 or 6 digits!"
End Select
ErrorLabel.Visible = IsError(RecordRow) 'hide/show error label
If Not IsError(RecordRow) Then LoadRecord lo.ListRows(RecordRow).Range
End Sub
'search a single-column range of data for an "ends with" match to `vSearch`
Function EndsWithMatch(vSearch, rngSrch As Range)
Dim i As Long, arr
arr = rngSrch.Value
For i = 1 To UBound(arr, 1)
If arr(i, 1) Like "*" & vSearch Then
EndsWithMatch = i
Exit Function 'done searching
End If
Next i
EndsWithMatch = CVErr(xlErrNA) 'no match: return error value as in Match()
End Function
Common to both answers (edit - added some suggestions for saving the edited record):
Dim editedRow as Range 'holds a reference to the row loaded for editing
'Better as a stand-alone method which you can call from other places...
Sub LoadRecord(sourceRow As Range)
With sourceRow
TextBoxNameAddress.Value = .Cells(4).Value & " - " & _
.Cells(3).Value & " - " & .Cells(1).Value
TextBoxHold.Value = .Cells(6).Value
'etc for other fields
End With
Set editedRow = sourceRow 'set a global for the row being edited
'also enable the "Save" button...
End Sub
Sub SaveRecord()
If Not editedRow Is Nothing Then
With editedRow
.Cells(6).Value = TextBoxHold.Value
'etc for the other fields
End With
Else
MsgBox "No row is being edited!"
End If
End Sub
It's easier/safer to test the return value from Match() than to turn off errors.
I have used the exact same code below for different sheets and it works correctly, but when I edited it for a new set of sheets in the same workbook the Run Time error comes up.
Private Sub cmdSearchKitDesc_Click()
Dim RowNum As Long
Dim SearchRow As Long
RowNum = 3
SearchRow = 3
Worksheets("Kit_database").Activate
Do Until Cells(RowNum, 1).Value = ""
If InStr(1, Cells(RowNum, 3).Value, txtKitKeyword.Value, vbTextCompare) > 0 Then
Worksheets("Kit_search").Cells(SearchRow, 2).Value = Cells(RowNum, 2).Value
Worksheets("Kit_search").Cells(SearchRow, 3).Value = Cells(RowNum, 3).Value
Worksheets("Kit_search").Cells(SearchRow, 4).Value = Cells(RowNum, 4).Value
Worksheets("Kit_search").Cells(SearchRow, 5).Value = Cells(RowNum, 6).Value
Worksheets("Kit_search").Cells(SearchRow, 6).Value = Cells(RowNum, 8).Value
Worksheets("Kit_search").Cells(SearchRow, 7).Value = Cells(RowNum, 9).Value
SearchRow = SearchRow + 1
End If
RowNum = RowNum + 1
Loop
If SearchRow = 2 Then
MsgBox "No kits were found that match your criteria."
Exit Sub
End If
lstKitResult.RowSource = "KitKit"
End Sub
I have changed RowNum to 3 to match the column of the sheet (in this case I would like to search the description of a kit) I would like to search and respectively in the string. I have carefully checked that the sheets and OFFSET function that it uses are named correctly.
The list box I would like to populate uses,
lstKitResult.RowSource = "KitKit" where "KitKit" uses the following OFFSET formula,
=OFFSET(Kit_search!$B$3,0,0,COUNTA(Kit_search!$C:$C)-1,6)
The "Kit_database" sheet holds all the different types of kits I would search from. The "Kit_search" sheet is a placeholder for all the results found that match the kit description searched. The OFFSET function pulls data "Kit_search" that should be populated with the search results of txtKitKeyword.Value
I have tried different column numbers and sheet names to make sure that things match up but the Run Time error always comes up.
It depends on what "KitKit" is. You would need to set the RowSourceType to correctly interpret the value. If you set it to "Value List" then the list would contain only "KitKit". So I must assume that you are trying to use a Table\Query or Field List. It sounds like you're saying "KitKit" is a named range that points to an offset formula. That would indeed be an error. The result of "KitKit" must contain and answer formatted to match the RowSourceType.
lstKitResult.RowSourceType = "Field List"
From the documentation:
The RowSource property setting depends on the RowSourceType property
setting. For this RowSourceType setting Enter this RowSource setting
Table/Query A table name, query name, or SQL statement.
Value List A list of items with semicolons (;) as separators.
Field List A table name, query name, or SQL statement.
Source: https://learn.microsoft.com/en-us/office/vba/api/access.listbox.rowsource
This code should find the correct cell (in the column corresponding to it's 'length' and the next empty row) in which to output a variable.
I'm getting the error message:
method range of object _worksheet failed
on lines 13 onward containing "outputcolumn"
In the MsgBox lines, the correct column and row number are being displayed, so I am not sure why it is not happy with my outputcolumn in particular.
Private Sub OutputRowAndColumn()
'Choose correct column: Find the length column and name this outputcolumn
Dim cell As Range, outputcolumn As Integer
Set cell = Range("FindLength").Find(Range("Length").Value, LookIn:=xlValues)
If Not cell Is Nothing Then
outputcolumn = cell.Column
End If
MsgBox "Output column is number " & outputcolumn & "."
'Choose correct row: If the cell to the left of "cell" is empty then this is the first row of output otherwise find next empty cell down
If Sheet1.Range(outputcolumn & "4").Offset(0, 1).Value = "" Then
outputrow = 4 ''' error msg '''
ElseIf Sheet1.Range(outputcolumn & "5").Offset(0, 1).Value = "" Then
outputrow = 5
Else
outputrow = Sheet1.Range(outputcolumn & "4").Offset(0, 1).End(xlDown).Row + 1
End If
MsgBox "Output row is number " & outputrow & "."
'Copy values 1, 2 and 3 from sheet 2 to sheet 1
Sheet1.Range(outputcolumn & outputrow).Offset(0, 1).Value = Sheet2.Range("Value1").Value ''' error msg '''
Sheet1.Range(outputcolumn & outputrow).Offset(0, 2).Value = Sheet2.Range("Value2").Value
Sheet1.Range(outputcolumn & outputrow).Offset(0, 3).Value = Sheet2.Range("Value3").Value
End Sub
outputcolumn is a numeric value (you defined it as Integer, but you always should define variables holding row or column numbers as long to avoid overflow errors).
So let's say outputcolumn gets the number 2 (column B). You write Sheet1.Range(outputcolumn & "4"). To access a range by it's address, You would have to write something like Range("B4"), but what you write is Range(2 & "4"), which means Range("24"), and that is an invalid address for a Range.
You could try to translate the column number 2 to a B, but there is an easier way to access a cell when you know the row and column number: Simply use the cells-property:
If Sheet1.Cells(4, outputcolumn).Offset(0, 1).Value = "" Then
' (or)
If Sheet1.Cells(4, outputcolumn+1).Value = "" Then
Just note that the order of the parameters is row, column.
"outputcolumn" is numeric in your case and when using .Range(), it needs to be a proper alphanumeric cell reference like "C5", not all numeric.
I haven't tried it directly but changing this ...
If Not cell Is Nothing Then
outputcolumn = cell.Column
End If
... to this ...
If Not cell Is Nothing Then
outputcolumn = Split(cell.Address, "$")(1)
End If
... will go a long way to helping you.
I am new to VBA and am trying to recode a program that already exists, with the intention of optimizing it and adding new features. The program takes a scanner input (though I am just manually entering in the numbers at the moment), which then records and categorizes the type of item that is taken out. It is then put in a log for reference later. Here is the first Userform that takes the scanned input:
Private Sub TextBox1_Change()
Dim barcode As Long, emptyRow As Long, testHold As Long
Set TempHold = Worksheets("TempHold")
If Application.WorksheetFunction.CountIf(TempHold.Range("D2:D25"), TextBox1.Value) = 1 Then
If Application.WorksheetFunction.CountIf(Range("B:B"), TextBox1.Value) = 0 Then
CartTypeMenu.Show
barcode = TextBox1.Value
emptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
Cells(emptyRow, 1).Value = Application.WorksheetFunction.VLookup(barcode, TempHold.Range("D2:E25"), 2, True)
Cells(emptyRow, 2).Value = barcode
Cells(emptyRow, 3).Value = Format(Now(), "mm/dd/yyyy hh:nn")
Cells(emptyRow, 4).Value = CartTypeMenu.ComboBox1.Value
TextBox1.Value = ""
Else
testHold = TextBox1.Value
Call boxTest(testHold)
End If
End If
End Sub
I have two tables in a separate sheet (TempHold) that have the scanned input corresponding to a number, and a number corresponding to a name. The row in the final log would basically be the number of the scanned input (as they are labeled by number), the scanned input, the time (which works properly), the type and then the name.
The problem I run into is when I search VLookup for the name to put into the next cell in the log row; getting the name from a number. It only looks for the name if it is actively in the log (it is cleared once tasks are completed). I have tried changing the numbers to strings, and vice versa, but I can't get it to work. Here is the problematic module:
Sub boxTest(testHold As Long)
Dim offsetValue As Long, myValue As Variant
Set ws = Worksheets("Log")
Set sheetLookup = Worksheets("TempHold")
offsetValue = Application.Match(testHold, ws.Range("B2:B8"), 0)
myValue = InputBox("Enter your number")
ws.Range("E" & offsetValue).Value = Application.WorksheetFunction.VLookup(myValue, sheetLookup.Range("A2:B9"), 1, True)
End Sub
VLookup keeps giving the error that it can't find the WorksheetFunction in this module.
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