Enter a search term, compare it with a table and output if found

[anglais428]

I would like to do the following:
Enter a search term into cell A1
Compare this search term with a lookup table (in range D1:D100)
If the text is found then it should return the word 'correct' in cell B1 and copy and paste the search term into a new range starting in cell A5
The text in cell A1 should then automatically be deleted (clear contents) and so that the next search term could be added and the above process would repeat.
If the search term is not found then the term "incorrect" should display in cell B1.

[TABLE="width: 500"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[/TR]
[TR]
[TD]<enter search term here>[/TD]
[TD]"correct" or "incorrect" text to be displayed here[/TD]
[TD][/TD]
[TD]Apples[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Bananas[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Oranges[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]Pears[/TD]
[/TR]
[TR]
[TD]<list would start here>[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

So If I entered "Apples" into cell A1, it would find it in the lookup list (column D), output the word "Apples" into cell A5, output the word "correct" into cell B1 and clear the contents of cell A1. Then if I entered the next word, Bananas, it would find it in the lookup list (column D), output the word "Bananas" into cell A6 (as Apples would be in cell A5), output the word "correct" into cell B1 and clear the contents of cell A1. If I entered "Food" then the word "incorrect" would be displayed in cell B1.

 

[Special-K99]

Unspecified solution method (e.g. Formulas / VBA).

Sounds like a job for VBA.

 

[anglais428]

I would prefer VBA but automated. I.e. so I do not have to run a macro each time. I would like it to work based off when a user enters data into cell A1.

 

[Special-K99]

I'm no VBA expert so wont be able to help on this, hopefully someone will come along with a solution.

 

[MickG]

Try this:-
Paste this code in your "Worksheet" Module.
:- Right click sheet TAB, select "View Code", VB Window appears , Paste Code in VB window.

Private [COLOR="Navy"]Sub[/COLOR] Worksheet_Change(ByVal Target [COLOR="Navy"]As[/COLOR] Range)
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object, Rng1 [COLOR="Navy"]As[/COLOR] Range, Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range("D1", Range("D" & Rows.Count).End(xlUp))
Lst = Range("A" & Rows.Count).End(xlUp).Row

[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
Application.EnableEvents = False
[COLOR="Navy"]If[/COLOR] Target.Address(0, 0) = "A1" [COLOR="Navy"]Then[/COLOR]
   [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng: Dic(Dn.Value) = Empty: [COLOR="Navy"]Next[/COLOR]
    [COLOR="Navy"]If[/COLOR] Dic.exists(Target.Value) [COLOR="Navy"]Then[/COLOR]
        Range("B1").Value = "Correct"
         [COLOR="Navy"]If[/COLOR] IsEmpty(Range("A5").Value) [COLOR="Navy"]Then[/COLOR]
            Range("A5").Value = Target: Target = ""
        [COLOR="Navy"]Else[/COLOR]
            Range("A" & Lst).Offset(1).Value = Target: Target = ""
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Else[/COLOR]
        Range("B1").Value = "Incorrect"
    [COLOR="Navy"]End[/COLOR] If
Range("A1").Select
[COLOR="Navy"]End[/COLOR] If
Application.EnableEvents = True
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[anglais428]

Thanks Mick, this is working perfectly!

 

[MickG]

You're welcome