patternMinor
Code to find value into a table by 2 criteria (x,y)
Viewed 0 times
criteriaintovaluefindcodetable
Problem
My code finds the value that corresponds to two values in a table. It works fine, but I'd like to know what you might do differently.
Table sample:
Input:
Output:
Code:
Table sample:
Input:
=findval(3200,100)Output:
4,6Code:
Function findval(x As String, y As String)
Dim LastRow As Long
Dim LastCol As Integer
Dim x_rgn As Range
Dim y_rgn As Range
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
With ActiveSheet
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
Set x_rgn = Range(Cells(1, 1), Cells(1, LastCol))
Set y_rgn = Range(Cells(1, 1), Cells(LastRow, 1))
With x_rgn
Set val_x = .Find(What:=x, _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
val_x = val_x.Address
val_x = Range(val_x).Column
End With
With y_rgn
Set val_y = .Find(What:=y, _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
val_y = val_y.Address
val_y = Range(val_y).Row
End With
findval = Cells(val_y, val_x).Value
End FunctionSolution
First step:
Write down your assumptions
These would be mine;
-
This data table has a header row in row 1 and a header column in column A.
-
The values in the headers could be any legal text.
-
The values in the headers are unique
What's the fastest way to find an exact match in a list?
My answer: A dictionary (or any other Linked-List object)
Now we have 2 dictionaries, where each row/column (i) is referenced by its cell value.
Now you just take your 2 input values, access the associated items, and either they exist and you have your co-ordinates, or they don't exist, and you can tell your user.
For added speed, read your row/column into an array before iteratively adding them to your list.
Bonus: Aside from the initial time to create the lists, searches are effectively instant for any size of list and any number of searches.
Write down your assumptions
These would be mine;
-
This data table has a header row in row 1 and a header column in column A.
-
The values in the headers could be any legal text.
-
The values in the headers are unique
What's the fastest way to find an exact match in a list?
My answer: A dictionary (or any other Linked-List object)
Dim rowList as Scripting.Dictionary, columnList as Scripting.Dictionary
Set rowList = New Scripting.Dictionary
Set columnList = New Scripting.Dictionary
finalrow = Cells(Rows.Count, 1).End(xlUp).Row
finalColumn = Cells(1, Columns.Count).End(xlToLeft).Column
Dim cellText As String
For i = 1 To finalrow
cellText = Cells(i, 1).Text
rowList.Add cellText, i
Next i
For i = 1 To finalColumn
cellText = Cells(1, i).Text
columnList.Add cellText, i
Next iNow we have 2 dictionaries, where each row/column (i) is referenced by its cell value.
rowList.item("0") will return row "5", "100" returns row "6" and so on. This will work with any size of table and any possible values for the headers, so long as there are no repeated values. Now you just take your 2 input values, access the associated items, and either they exist and you have your co-ordinates, or they don't exist, and you can tell your user.
For added speed, read your row/column into an array before iteratively adding them to your list.
Bonus: Aside from the initial time to create the lists, searches are effectively instant for any size of list and any number of searches.
Code Snippets
Dim rowList as Scripting.Dictionary, columnList as Scripting.Dictionary
Set rowList = New Scripting.Dictionary
Set columnList = New Scripting.Dictionary
finalrow = Cells(Rows.Count, 1).End(xlUp).Row
finalColumn = Cells(1, Columns.Count).End(xlToLeft).Column
Dim cellText As String
For i = 1 To finalrow
cellText = Cells(i, 1).Text
rowList.Add cellText, i
Next i
For i = 1 To finalColumn
cellText = Cells(1, i).Text
columnList.Add cellText, i
Next iContext
StackExchange Code Review Q#109264, answer score: 8
Revisions (0)
No revisions yet.