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
Dart ID	Item	Item type
D1881031654	1N	Supplies
D1881031654	5T	Supplies
D1881031654	UK	Supplies
D1881113260	C5	Hardware
D1881113260	AK	Hardware
D1881113260	4X	Hardware
D1881113260	PQ	Hardware
D1881113260	2B	Hardware
D1881114542	ST	Hardware
D1881114542	K5	Hardware
D1881114542	AK	Hardware
D1881114542	C5	Hardware
D1881114542	8A	Hardware
D1881114542	5T	Supplies

<tbody>
[TD="align: center"]1[/TD]

[TD="align: center"]2[/TD]

[TD="align: center"]3[/TD]

[TD="align: center"]4[/TD]

[TD="align: center"]5[/TD]

[TD="align: center"]6[/TD]

[TD="align: center"]7[/TD]

[TD="align: center"]8[/TD]

[TD="align: center"]9[/TD]

[TD="align: center"]10[/TD]

[TD="align: center"]11[/TD]

[TD="align: center"]12[/TD]

[TD="align: center"]13[/TD]

[TD="align: center"]14[/TD]

[TD="align: center"]15[/TD]

</tbody>

Sheet2​

For now I am using the below formulas to determine the final type of each ID:
[TABLE="width: 85%"]
<tbody>[TR]
[TD]Worksheet Formulas[TABLE="width: 100%"]
<tbody>[TR="bgcolor: #DAE7F5"]
[TH]Cell[/TH]
[TH="align: left"]Formula[/TH]
[/TR]
[TR]
[TH="bgcolor: #DAE7F5"]C2[/TH]
[TD="align: left"]=VLOOKUP(B2,'[IE TOOL AUTOMATION - v2-macro.xlsm]System'!C:D,2,0)[/TD]
[/TR]
[TR]
[TH="bgcolor: #DAE7F5"]D2[/TH]
[TD="align: left"]=IF(C2="Hardware",1,0)[/TD]
[/TR]
[TR]
[TH="bgcolor: #DAE7F5"]E2[/TH]
[TD="align: left"]=IF(C2="Supplies",1,0)[/TD]
[/TR]
[TR]
[TH="bgcolor: #DAE7F5"]F2[/TH]
[TD="align: left"]=IF(SUMIF(A:A,A:A,D:D)>0,1,0)[/TD]
[/TR]
[TR]
[TH="bgcolor: #DAE7F5"]G2[/TH]
[TD="align: left"]=IF(SUMIF(A:A,A:A,E:E)>0,1,0)[/TD]
[/TR]
[TR]
[TH="bgcolor: #DAE7F5"]H2[/TH]
[TD="align: left"]=IF(SUM(F2:G2)=2,"HW and Supplies",IF(F2=1,"Hardware","Supplies"))[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]

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.