Unresolved Express Query - Compare two Columns and return text - Complex

[Darryl101]

Hi Forum,

This was originally posted on another forum a few days ago and was unable to be resolved.

Due to large complex spreadsheet and calculations switched off looking for vba code if possible to populate column c.

Column A	Column B	Column C (code to return)
ProductC	MachineA	ProductC
ProductC	MachineA	ProductC
ProductC	MachineA	ProductC
ProductA	MachineB	Mixed
ProductC	MachineB	Mixed
etc	etc	etc

<tbody>
</tbody>

If a Machine (column B) only produces one type of product (columnA) then looking for it to return the product in column A i.e. product C, If a machine produces more than one product then hoping for the code to return the word Mixed (i.e. Machine B produces two products A & B so it is mixed products). The same machine may have more than 1 occurance in column B, there is 8000+ rows and looking for vba code to populate C (hoping please to keep the spreadsheet as is, i.e. not remove duplicates in B or sort etc). I then intend to do a lookup based on the Machine in another sheet to find out if it only produces one or multiple products (this I can do).


If anyone can think of a solution that would be great

Thanks Forum

 

[MickG]

Try this:- Results column "C"
NB:- Your Data starts row(2)

[COLOR="Navy"]Sub[/COLOR] MG27Jun00
[COLOR="Navy"]Dim[/COLOR] Rng         [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn          [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Temp        [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Q
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("B2"), Range("B" & 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, Array(Dn, Dn.Offset(, -1))
        Dn.Offset(, 1) = .Item(Dn.Value)(1)
    [COLOR="Navy"]Else[/COLOR]
        Q = .Item(Dn.Value)
            [COLOR="Navy"]Set[/COLOR] Q(0) = Union(Q(0), Dn)
                [COLOR="Navy"]If[/COLOR] Not Dn.Offset(, -1) = Q(1) [COLOR="Navy"]Then[/COLOR]
                    Q(1) = "Mixed"
                [COLOR="Navy"]End[/COLOR] If
                     Q(0).Offset(, 1).Value = Q(1)
        .Item(Dn.Value) = Q
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Darryl101]

Legend Thanks Mick... Smart Man

 

[MickG]

Pleasure !!
Thanks for the feedback
Regards Mick