Showing unique value for a certain ID

[DaVicious]

Hello,

I am trying to improve my code that is telling me the type of an ID based on what it contains.
The data looks like this:

Excel 2010

	A	B	C
1	Dart ID	Item	Item type
2	D1881031654	1N	Supplies
3	D1881031654	5T	Supplies
4	D1881031654	UK	Supplies
5	D1881113260	C5	Hardware
6	D1881113260	AK	Hardware
7	D1881113260	4X	Hardware
8	D1881113260	PQ	Hardware
9	D1881113260	2B	Hardware
10	D1881114542	ST	Hardware
11	D1881114542	K5	Hardware
12	D1881114542	AK	Hardware
13	D1881114542	C5	Hardware
14	D1881114542	8A	Hardware
15	D1881114542	5T	Supplies

<tbody>
</tbody>

Sheet2​

For now I am using the below formulas to determine the final type of each ID:

Worksheet Formulas Cell Formula C2 =VLOOKUP(B2,'[IE TOOL AUTOMATION - v2-macro.xlsm]System'!C:D,2,0) D2 =IF(C2="Hardware",1,0) E2 =IF(C2="Supplies",1,0) F2 =IF(SUMIF(A:A,A:A,D:D)>0,1,0) G2 =IF(SUMIF(A:A,A:A,E:E)>0,1,0) H2 =IF(SUM(F2:G2)=2,"HW and Supplies",IF(F2=1,"Hardware","Supplies")) <tbody> </tbody>

<tbody>
</tbody>

What basically does is:

1. In column C it determines the type of the contained items
2. In columns D and E puts 1 or 0 depending on the item type
3. In columns F and G puts 1 or 0 depending on item type and DART ID
4. In column H it is establishing the final DART ID type

Until now I was using the below code.
<code>
Macro.Range("C" & LastRow3 + 2).FormulaR1C1 = "=VLOOKUP(RC[-1],System!C:C[+1],2,0)" 'Find item type
Macro.Range("C" & LastRow3 + 2).AutoFill Destination:=Range("C" & LastRow3 + 2 & ":C" & LastRow1)
Macro.Range("D" & LastRow3 + 2).FormulaR1C1 = "=IF(RC[-1]=""Hardware"",1,0)" 'Replace "hardware" with 1 value
Macro.Range("D" & LastRow3 + 2).AutoFill Destination:=Range("D" & LastRow3 + 2 & ":D" & LastRow1)
Macro.Range("E" & LastRow3 + 2).FormulaR1C1 = "=IF(RC[-2]=""Supplies"",1,0)" 'Replace "Supplies" with 1 value
Macro.Range("E" & LastRow3 + 2).AutoFill Destination:=Range("E" & LastRow3 + 2 & ":E" & LastRow1)
Macro.Range("F" & LastRow3 + 2).FormulaR1C1 = "=IF(SUMIF(C[-5],C[-5],C[-2])>0,1,0)" 'Sums the "Harware" and/or "Supplies" results
Macro.Range("F" & LastRow3 + 2).AutoFill Destination:=Range("F" & LastRow3 + 2 & ":F" & LastRow1)
Macro.Range("G" & LastRow3 + 2).FormulaR1C1 = "=IF(SUMIF(C[-6],C[-6],C[-2])>0,1,0)" 'Sums the "Harware" and/or "Supplies" results
Macro.Range("G" & LastRow3 + 2).AutoFill Destination:=Range("G" & LastRow3 + 2 & ":G" & LastRow1)
Macro.Range("H" & LastRow3 + 2).FormulaR1C1 = "=IF(SUM(RC[-2]:RC[-1])=2,""HW and Supplies"",IF(RC[-2]=1,""Hardware"",""Supplies""))" 'Fill H column with the DART type
Macro.Range("H" & LastRow3 + 2).AutoFill Destination:=Range("H" & LastRow3 + 2 & ":H" & LastRow1)
Macro.Calculate

I want to shorten it in order to calculate faster. I am out of ideas on how to do this.

Any help would be appreciated.

Thank you!</code>

 

[Jon von der Heyden]

I think you can do this in one shot after your initial vlookup in column C. So, for instance in D2:

=IF(SUM(COUNTIFS($A$2:$A$15,A2,$C$2:$C$15,{"supplies";"hardware"}))>COUNTIFS($A$2:$A$15,A2,$C$2:$C$15,C2),"HW and Supplies",C2)

 

[MickG]

Based on your Data (start Row 2) columns "A to C", results returned in column "D".

[COLOR="Navy"]Sub[/COLOR] MG27Jun44
[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("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]
        Temp = Dn.Offset(, 2)
        .Add Dn.Value, Array(Dn, Temp)
        Dn.Offset(, 3) = Temp
    [COLOR="Navy"]Else[/COLOR]
        Q = .Item(Dn.Value)
            [COLOR="Navy"]Set[/COLOR] Q(0) = Union(Q(0), Dn)
                [COLOR="Navy"]If[/COLOR] InStr(Q(1), Dn.Offset(, 2).Value) = 0 [COLOR="Navy"]Then[/COLOR]
                    Q(1) = Q(1) & " and " & Dn.Offset(, 2)
                [COLOR="Navy"]End[/COLOR] If
                     Q(0).Offset(, 3).Value = Q(1)
        .Item(Dn.Value) = Q
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[DaVicious]

Hello,

Thank you Jon, Mick for your help.

Your solutions where very useful.

Again, thank you for your time.