Take selection validate and delete

[hobo]

Hey guys,

Dunno if this is an easy one for you excel guru's out there but i'll give it a stab.

I need a macro that will view a group of cells i have selected and delete any rows that have an identical value in each selected cell in that row.

EG.

Mark, procured, processed, fabricated, welded, despatched
item(a), 1, 1, 1, 1, 1
item(b), 1, 1, 1, 1, 2
item(c), 1, 1, 1, 1, 1
item(d), 1, 2, 2, 1, 1

I i draged my cursor over the data in the procured, processed, fabricated, welded, despatched columns and ran the macro it would need to delete row with item(a) and item(c) because those values were identical in each cell.

I assume i would start the macro with:

For Each cell In Selection <-- as this would use the selected cells for the data to filter, but i dunno where to go from there.

Cheers guys,
Ant

 

[hobo]

bump

 

[tactps]

Type the following formula into G1 and copy down:
=SUMPRODUCT(--(B2:$B$9=B1),--(C2:$C$9=C1),--(D2:$D$9=D1),--(E2:$E$9=D1))

Then run this macro()

Sub Macro1()
Dim cell As Range
[g65536].End(xlUp).Select
Do Until ActiveCell.Row = 1
If ActiveCell.Value > 0 Then ActiveCell.EntireRow.Delete
ActiveCell.Offset(-1, 0).Select
Loop
If ActiveCell.Value > 0 Then ActiveCell.EntireRow.Delete
End Sub

 

[Tazguy37]

You could always incorporate the SUMPRODUCT() into the code, Anton :wink: EDIT: What was I thinkin'?

Nice solution, BTW

 

[Nimrod]

INSTRUCTION:
(1) Select the area you wish to evaluate
(2) Run Maco called "DeleteDupes"

ASSUMPTIONS
- That column IV is blank and available for temp use.

Public Sub DeleteDupes()
    'MAKE A SINGLE STRING OF ROW
    Call MakeCombStr
    
    'FIND OUT IF COMBINED STRING IS UNIQUE
    Call ClearUniquesCombStr
    
    'DELETE ANY ROWS THAT ARE NOT UNIQUE
    On Error Resume Next
    Columns("IV:IV").SpecialCells(xlCellTypeConstants, 3).EntireRow.Delete

End Sub

Private Sub MakeCombStr()
For Each R In Selection.Rows
    TheStr = ""
    For Each c In R.Columns
        TheStr = TheStr & c.Value
    Next c
    Cells(R.Row, 256).Value = TheStr
Next R
End Sub

Private Sub ClearUniquesCombStr()
On Error GoTo TheEnd
For Each CombStr In Columns("IV:IV").SpecialCells(xlCellTypeConstants, 3)
    If WorksheetFunction.CountIf(Columns("IV:IV"), CombStr) < 2 Then
        CombStr.ClearContents
    End If
Next CombStr
TheEnd:
End Sub