Copy Text In Multiple Columns Based on ID

[YeahYouKnowMe]

I am wondering if there is a VBA method or guide to have text descriptions automatically fill-in for a Unique ID anytime a user enters a previously made entry in a database. For example, a user initally enters:

ID	Description 1	Description2
X_01	Tall	Old

<tbody>
</tbody>

Ideally, I would like code that automatically fills in the Description columns the next time I enter X_01 into a new row. Also, I would like this to apply to any other ID that is entered with different values for the description variables.

Thanks for the help!

 

[MickG]

Try this:-
Note this is a "Change event" code that
will run when you Insert a Value in column "A"

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, n [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]If[/COLOR] Target.Column = 1 [COLOR=navy]Then[/COLOR]
    [COLOR=navy]Set[/COLOR] Rng = Range("A1", 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]
                    [COLOR=navy]Set[/COLOR] .Item(Dn.Value) = Dn
                [COLOR=navy]End[/COLOR] If
            [COLOR=navy]Next[/COLOR]
                [COLOR=navy]If[/COLOR] .exists(Target.Value) [COLOR=navy]Then[/COLOR]
                    Target.Offset(, 1).Value = .Item(Target.Value).Offset(, 1).Value
                    Target.Offset(, 2).Value = .Item(Target.Value).Offset(, 2).Value
                [COLOR=navy]End[/COLOR] If
        [COLOR=navy]End[/COLOR] With
[COLOR=navy]End[/COLOR] If
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

To save a run code:-
Right click sheet "Tab" , Select "View Code", Vb window appears.
Paste code into Vbwindow
Close Vbwindow.

When you now change a value then click "Enter" in column "A", Columns "B" and "C" will update,
if there is a previous matching value in "A"


Regards Mick

 

[YeahYouKnowMe]

This is great! Works perfect but I was wondering if there was a way to program it to a button or modify the code to automatically update all IDs at the same time. For example if I have the following:

ID	Description 1	Description 2
X_01	Tall	Long
X_01
X_01

<tbody>
</tbody>

With the current code, I have to double click or hit enter on each cell w/ X_01 and it updates just that single row. Is there a way to either 1) Have an activeX button that will update all rows with the same ID or 2) as soon as I update the cell to "X_01", it will automatically fill in the relevant information without me having to go back and double-click each cell?


Thanks!

 

[MickG]

Try this code for a "CommandButton"

Private [COLOR="Navy"]Sub[/COLOR] CommandButton1_Click()
[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]
[COLOR="Navy"]Set[/COLOR] Rng = Range("A1", 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"]Else[/COLOR]
                    Dn.Offset(, 1).Value = .Item(Dn.Value).Offset(, 1).Value
                    Dn.Offset(, 2).Value = .Item(Dn.Value).Offset(, 2).Value
                [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]Next[/COLOR]
                
        [COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick