Need advice how to write VBA code for solving the below problem

[Barath]

I have 2 tables as shown below
Table 1
AA
BB
CC
DD
EE
Table 2
bb
aa
bb1
bb2
cc1
cc2
cc3
I need help to do the below steps using Excel VBA code

1. Use Table 1 and loop thru each data in table 1 and compare to Table 2
   
2. If table 2 only have 1 match, just replace the Table 1 data from the table 2 value on the same row of data from table 1
   
3. If have multipe match from table 2, them prompt user to select which data from table 2 need to be written in table 1

Matching Criteria are as follows
AA should match to aa,aa1,aa2,,,,,,
BB shoud match bb,bb1,bb2,,,,,,,,
Thanks

 

[MickG]

Try this:-
Table 1 in column "A" , Table 2 in column "C"

[COLOR="Navy"]Sub[/COLOR] MG21Jan21
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] nTxt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] oSel [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, Sp [COLOR="Navy"]As[/COLOR] Variant, NuTxt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not .exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        .Add Dn.Value, Dn
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("C2"), Range("C" & Rows.Count).End(xlUp))
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
NuTxt = ""
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    Txt = ""
    [COLOR="Navy"]For[/COLOR] n = 1 To Len(Dn.Value)
        [COLOR="Navy"]If[/COLOR] Dn.Characters(n, 1).Text Like "[A-Za-z]" [COLOR="Navy"]Then[/COLOR]
            Txt = Txt & Dn.Characters(n, 1).Text
          
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] n
    [COLOR="Navy"]If[/COLOR] UCase(K) = UCase(Txt) [COLOR="Navy"]Then[/COLOR]
        nTxt = nTxt & IIf(nTxt = "", Txt, "," & Txt)
        NuTxt = NuTxt & IIf(NuTxt = "", Dn.Value, "," & Dn.Value)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
    [COLOR="Navy"]If[/COLOR] nTxt <> "" [COLOR="Navy"]Then[/COLOR]
    Sp = Split(nTxt, ",")
    [COLOR="Navy"]If[/COLOR] UBound(Sp) > 0 [COLOR="Navy"]Then[/COLOR]
        oSel = Application.InputBox(prompt:="Enter Text required :-" & NuTxt, Title:="Select Option", Type:=2)
        .Item(K).Value = oSel: nTxt = ""
        oSel = ""
    [COLOR="Navy"]Else[/COLOR]
        .Item(K).Value = nTxt: nTxt = ""
    [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Barath]

Thank you so much Mick. You have help me in split seconds. I was working this for a few days. thanks again.

 

[MickG]

You're welcome