ExcelBanter - Deleting Duplicates BUT with a twist

John

Don't know if the first reply didn't make it or the newsgroup update is slow. Try the following.

Tony

Sub bbb()
Dim soilname As New Collection
Dim locs As New Collection

'get unique soilnames
On Error Resume Next
For Each sn In Range("a3:a11")
soilname.Add sn.Value, sn.Value
Next sn

'get unique locations
For Each Lo In Range("b3:b11")
locs.Add Lo.Value, Lo.Value
Next Lo

On Error GoTo 0
'output headings
Range("g14").Value = "Location"
Range("g15").Value = "Soil Name"

'output unique values
Range("h14").Select
For Each Lo In locs
ActiveCell.Value = Lo
ActiveCell.Offset(0, 1).Select
Next Lo

Range("g16").Select
For Each sn In soilname
ActiveCell.Value = sn
ActiveCell.Offset(1, 0).Select
Next sn

'put in formulas
Range("h16").Formula = "=IF(SUMPRODUCT(--($A$3:$A$11=$G16),--($B$3:$B$11=H$14)),""YES"","""")"
Range("h16").Copy Destination:=Range("h16:j20")

End Sub

----- John Young wrote: -----

What I am trying to solve is the following.

A | B
---------------------
SOIL NAME LOCATION
JY1 | L
HG | L
AT | B
AT | B
LS | L
PR | S
JY1 | S
JY1 | B
PR | B
Result I am aiming for is:
A | B | C | D | E | F |
LOCATION L B S
SOIL NAME
JY1 YES YES YES
HG YES
AT YES
LS YES
PR YES YES

What I want to be able to do is to remove all duplicate
soil names eg all JY1, so that only one is listed, but
check the information to the right of it & if it is
different add it next to the one that is kept. I suppose
its like a pivot table, but I want to be able to run a
macro to do this.

help needed. I have written code that can automatically
delete duplicates, but I dont know how to do the rest.

Kind regards

John