Solved: Best Practice Lookup

[londresw]

Hi,

I would like some opinions on best practice to solve the following problem.

I need to create a permanent list, two columns wide, by unknown length. I need the first column to be a value to be looked up and the second the be the value returned. E.g.

A, 10
B, 30
C, 50

where b would return 30 etc.

I don't really want to do this inside of the same workbook since I want it to be able to be used across workbooks, later as an add-in, which I'll come to in good time. For now though that's my challenge and I'd appreciate any advice / a pointer in the right direction!

PS. To further compliate matters, I'd also like to be able to add to this list if the searched for vlue isn't already in the list.. e.g.

searching for D, not there, user-input to add 'D, 10' to the list and return 10, save the list permanently.

Many thanks, as ever,


Scott

[mikerickson]

It sounds like a standard VLOOKUP would work.
The "Add to" part could be done if the you create a named range myLookupRange and add this Calculate event at what ever level (Application, Workbook, or Worksheet) you want.
If a spreadhseet formula with VLOOKUP(expression,myLookupRange,2) or VLOOKUP(expression,myLookupRange,2,FALSE) returns an error, this routine will prompt you for a value and add a row to myLookupRange.

[VBA]Private Sub Worksheet_Calculate()
Dim oneCell As Range, formulaStr As String, highChr As Long, i As Long
Dim newKey As Variant, newValue As Variant, promptStr As String
On Error GoTo HaltRoutine
For Each oneCell In ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, xlErrors)
formulaStr = oneCell.Formula
If formulaStr Like "=*VLOOKUP(*,myLookupRange,2*" Then
highChr = InStr(formulaStr, ",myLookupRange,2") - 1
For i = highChr To 1 Step -1
If Mid(formulaStr, i, 1) = "(" Then
newKey = Evaluate(Mid(formulaStr, i + 1, highChr - i))
Exit For
End If
Next i
promptStr = "There is no " & Chr(34) & newKey & Chr(34) & " in the chart."
promptStr = promptStr & vbCr & "What is the value of " & Chr(34) & newKey & Chr(34)
newValue = Application.InputBox(promptStr, Type:=7)
If newValue <> "False" Then
With Range("myLookupRange")
.Offset(.Rows.Count, 0).Resize(1, 2).Value = Array(newKey, newValue)
.Resize(.Rows.Count + 1, 2).Name = "myLookupRange"
End With
End If
End If
Next oneCell
Exit Sub
HaltRoutine:
On Error GoTo 0
End Sub[/VBA]

[londresw]

Eek. I think I have made an error in explaining what I was trying to achieve.

I wanted a 'hidden' solution - i.e. I wanted this to run this without the user needing to see it and it's only part of a larger program I'm trying to write.

What I need to do is to have a permanent storage of a lookup values - I needed to check whether a string variables is in that hidden list and if it is, return it's corresponding string value.

Is this do-able?

[Paul_Hossler]

One way that might give you some ideas to customize

I did a hidden sheet with two col's called Translate, and put a Change event on the sheet that I wanted to use.

If you enter a 'known' value, this will put a 'looked up' value immediatlt to it's right


If you enter a 'unknown' value in a cell, then if you immediately enter a value to it's immediate right, both are added to the translate table


[vba]
Option Explicit
Dim rPrevious As Range
Private Sub Worksheet_Change(ByVal Target As Range)
Dim v As Variant


'is this one immediatedly after a 'not found' and in the cell to the right
If Not rPrevious Is Nothing Then
If Target.Cells(1, 1).Address(1, 1, 1, 1) = rPrevious.Offset(0, 1).Address(1, 1, 1, 1) Then
Worksheets("Translate").Cells(1, 1).End(xlDown).Offset(1, 0).Value = rPrevious.Value
Worksheets("Translate").Cells(1, 2).End(xlDown).Offset(1, 0).Value = Target.Cells(1, 1).Value
Set rPrevious = Nothing
End If
End If


'see if we're lucky and this value is in the table
On Error Resume Next
v = Application.VLookup(Target.Cells(1, 1), Worksheets("Translate").Range("A:B"), 2, False)
On Error GoTo 0

'if it's in the table, put it in the cell to the right
If Not VarType(v) = vbError Then
Target.Cells(1, 1).Offset(0, 1).Value = v
Set rPrevious = Nothing
Exit Sub
End If
'save this cell
Set rPrevious = Target.Cells(1, 1)
End Sub
[/vba]


Paul