How to Create a dynamic Unique list that updates automatically

[earthworm]

I have row that keep updating .

i somehow need to create database link to the the data where user is inputting the values (if required) and vlookup formula updates automatically

in other words

the formula is circular

this is how i want the formula to work

1) Check the data from vlookup to search the value in column A from sheet 2
2) If the value is found in sheet 2 , show me the result in column B of sheet 1
3) if the value is not found , the sheet 2 picks the manual value inputted by user and updates itself so that the next time when the value comes , the user does not have to enter the same value again which he did previously

how to achieve this . i dont need to provide the sample, since this is a simple logic on which i m confused.

 

[MrExcel]

Let me restate the problem to make sure I understand it.

A) You have a lookup table in A:B of Sheet2
B) Someone enters something in column A of Sheet1
C) You want to attempt a VLOOKUP from that new entry in Sheet1!A to get the column B value from Sheet2. If the item is found, just put the description in column B of Sheet1. However, if the item is not found, you want to prompt the user for the correct value and then insert this new item into Sheet2 so that the VLOOKUP for this row and any future rows will automatically work.

My solution will require VBA. I am thinking of an event handler macro that runs every time there is a change on Sheet1.

Here is some pre-work before you start coding:
1) If the workbook is currently saved with XLSX file type, do a Save As and change to XLSM
2) If you have never used macros before, Go to Alt+T M S and change the security setting to the 2nd item
3) In your lookup table, add a new last row with ZZZ in column A and Add New Items Above Here in column B.

This macro has to be located on the code pane for Sheet1. Follow these steps to locate that code pane:
4) From Excel, press Alt+F11
5) If you can not see the Project Explorer, press Ctrl+R
6) In the Project Explorer, expand the tree view for your workbook, then Microsoft Excel Objects, then double-click on Sheet1.

You will see two dropdowns above the code pane.
7) Open the top left dropdown and choose Worksheet. By default, the top right dropdown changes to Selection Change and the start of a Worksheet_SelectionChange macro appears in the code pane. Delete these lines.
8) From the top right dropdown, choose Change. You will now have the start of a Worksheet_Change macro.

9) Paste the following code:

Private Sub Worksheet_Change(ByVal Target As Range)
    ' If they changed multiple cells, do not proceed
    If Target.Cells.Count > 1 Then Exit Sub
    ' If the change was not in A, do not proceed.
    If Target.Column > 1 Then Exit Sub
    ' Which Row just changed?
    MyRow = Target.Row
    ' How many rows on Sheet2
    FinalRow = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
    ' Before writing anything to Sheet1, turn off event handler
    Application.EnableEvents = False
    Cells(MyRow, 2).FormulaR1C1 = "=IFERROR(VLOOKUP(RC1,Sheet2!R1C1:R" & FinalRow & "C2,2,False),""Not Found"")"
    
    ' Test if the new column B is Not Found
    If Cells(MyRow, 2).Value = "Not Found" Then
        MyDesc = InputBox(Prompt:="Enter the description for " & Target.Value, Title:="You entered a new product")
        ' They might have clicked Cancel, which would seem
        ' to indicate that this is not really a new product.
        ' Clear column A in this case
        If MyDesc = "" Then
            Cells(MyRow, 1).Select
            Cells(MyRow, 1).Resize(1, 2).Clear
            Application.EnableEvents = True
            MsgBox "Please re-enter the correct item number"
            Exit Sub
        End If
        ' Add the new item to Sheet2
        ' Insert a new row above the last row
        Worksheets("Sheet2").Cells(FinalRow, 1).EntireRow.Insert
        Worksheets("Sheet2").Cells(FinalRow, 1).Resize(1, 2).Value = Array(Target.Value, MyDesc)
    End If
    
    ' Turn back on the event handler
    Application.EnableEvents = True
    
End Sub

I am using this question as the basis for my podcast 1868. That video is here: http://youtu.be/JFTvm-fnPNc

Bill

 

[earthworm]

ahhhhhhhh Bill Jelen , you always win by using VBA
truely amazing . I still like to prefer formula because its easy to move the formula if your data is located in different cell , but suppose i have data not in cell A1 then i will have to amend the VBA Code piece by piece by giving relevant link to formula , which will consume a lot of time .
Do you think Mike can solve this ?
thanks for your support !

 

[Aukus]

Hi Bill,
Whenever you or Mike post these solutions I have a go at developing my own as an exercise in lateral thinking. Usually I can't beat what you two post.
This time I have an alternative for you.

Three defined names and 16 lines of VBA (not counting line wraps or comments).

Defined Name ProductList =OFFSET(Sheet1!$A$1,0,0,COUNTA(Sheet1!$A:$A),2)
Defined Name ProductTable =OFFSET(Sheet2!$A$1,0,0,COUNTA(Sheet2!$A:$A),2)
Defined Name GetDescription =IFERROR(INDEX(ProductTable,MATCH(Sheet1!$A9,OFFSET(ProductTable,0,0,,1),0),2),"Not Found")

In VBA, I used the Worksheet_Change() function, as you did, with a shorter procedure.

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Cells.Count > 1 Then Exit Sub
  If Intersect(Target, Range("ProductList").Columns(1)) Is Nothing Then Exit Sub
  Application.EnableEvents = False
     '  Put formula in Description cell.
  Target.Cells(1, 2).Formula = "=GetDescription"
  If Target.Cells(1, 2) = "Not Found" Then
    Dim sAnswer As String
     sAnswer = InputBox(Target & " is not in the Product List." &  vbLf & "If it is a new product then enter a new description." &  vbLf & "If it is a typo then press <CANCEL>")
    If sAnswer = "" Then
      Target.Resize(1, 2).Delete
    Else
      Sheet2.Range("ProductTable").Rows(Sheet2.Range("ProductTable") _
      .Rows.Count + 1) = Array(Target, sAnswer)
    End If
  End If
  Application.EnableEvents = True
End Sub

I also posted this on the YouTube video.

Keep EXCELling,
Dave