# Showing unique value for a certain ID

#### DaVicious

##### New Member
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
ABC
1Dart IDItemItem type
2D18810316541NSupplies
3D18810316545TSupplies
4D1881031654UKSupplies
5D1881113260C5Hardware
6D1881113260AKHardware
7D18811132604XHardware
8D1881113260PQHardware
9D18811132602BHardware
10D1881114542STHardware
11D1881114542K5Hardware
12D1881114542AKHardware
13D1881114542C5Hardware
14D18811145428AHardware
15D18811145425TSupplies

<tbody>
</tbody>
Sheet2
For now I am using the below formulas to determine the final type of each ID:
Worksheet Formulas
CellFormula
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>

### Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
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)

Based on your Data (start Row 2) columns "A to C", results returned in column "D".
Code:
``````[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)
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

Hello,

Thank you Jon, Mick for your help.

Again, thank you for your time.

Replies
3
Views
273
Replies
5
Views
200
Replies
0
Views
306
Replies
12
Views
452
Replies
1
Views
296

1,203,250
Messages
6,054,383
Members
444,721
Latest member
BAFRA77

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back