Solved: Strange find non duplicates

cdkeito

Board Regular
Joined
Aug 26, 2005
Messages
95
Hi all,

a lite problem for you:
Cartel1
ABCD
1blau1bla
21blo
31bli
4blodu2bla
52blo
62bli
72bla
82blo
9blitri3bli
103bla
11bluquater4blo
124bli
13blesic5bla
145blo
155bli
165bla
175blo
185bli
195bla
205blo
21blyses6bli
226bla
236blo
Foglio1



How do I find and delete non duplicates value in column B?

A rule say that every value in B has a different value in C, so a duplicate has the same value in B but different in C.


thannnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnnks
 
I've written some code:

Code:
Sub DeleteNoDplARP()
    Application.ScreenUpdating = False
    Dim k As Integer
    Dim r As Range
    Dim f As Range
    Dim riga As String
        
    k = Sheets("Report Presenze").Range("d65536").End(xlUp).Row
    Columns("E").Insert shift:=xlToRight
    For Each r In Sheets("Report Presenze").Range("a10:a" & k)
        If r.Offset(, 2) <> "" Then
            r.Offset(, 4).Formula = "=countif(c$10:c$" & k & ",c" & r.Row & ")"
        End If
    Next
    Range("e10:e" & k).Select
    'Columns("e").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlValues, operation:=xlNone, skipblanks:=False, Transpose:=False
    ActiveSheet.Paste
    Application.CutCopyMode = False
    
    riga = ""
    For Each r In Sheets("Report Presenze").Range("a10:a" & k)
        If r.Offset(, 2) <> "" And riga <> "" Then
            Range(riga).EntireRow.Delete
            riga = ""
        End If
        If r.Offset(, 2) <> "" And r.Offset(, 4) = 1 And riga = "" Then
            riga = r.Address(0, 0)
        End If
        If r.Offset(, 2) = "" And riga <> "" Then
            riga = riga & "," & r.Address(0, 0)
        End If
    Next    '''''''''''''''''''''''''''<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    Range(riga).EntireRow.Delete
    Columns("E").Delete shift:=xlToLeft
    
    k = Sheets("Report Presenze").Range("d65536").End(xlUp).Row
    For Each r In Sheets("Report Presenze").Range("a10:a" & k)
        If r.Value = "" Then r.FormulaR1C1 = "=R[-1]C"
        If r.Offset(, 1).Value = "" Then r.Offset(, 1).FormulaR1C1 = "=R[-1]C"
        'If r.Offset(, 2).Value = "" Then r.Offset(, 2).FormulaR1C1 = "=R[-1]C"
    Next
    'Range("A10:AQ" & k).Sort Key1:=Range("B10"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    Application.ScreenUpdating = True
End Sub

some hope?
 
Upvote 0

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
now I've momentarily changed the
... .delete
to
... .interior.color = vbred

and added after "Columns("E").Delete shift:=xlToLeft "

an

for i=k to 10 step=-1
if cells(i,1).interior.color = vbred then rows(i).delete
next i

but this it does 3 swings of the sheet (normaly 400 rows, 300-400 sheets)

so its SLOOOOOOOOOOOOOOOW!

感謝
 
Upvote 0
cdkeito said:
...

In this example, you see, b1 and b10 are the same. I need to delete rows 3 :9;13:15.

I've writen something that use countif (on rows 1,3,7,10,13,14) and a later scan that analyze the results, storing the rows' number to delete (countif = 1); but, probably, you've a better idea.

Grazie!
UniqueRecs.xls
ABCDEFGHIJKLM
105
2X-1X-2X-3X-4X-5IdxPosX-1X-2X-3X-4X-5
3dfdsfa1sdsdsd11dfdsfa1sdsdsd
41fdsffdsf22  1fdsffdsf
5fdfsb2dfdsfjghj 10,l,ihga45jkgh,mkghj
62gfdggfdgfd 11  45jmkmkj
72gdffgdf 12  45ghmnjfgfjn
82utyukhjk       
9hgfhc9fdjhgjyjn  
Sheet1


F1 must house a 0.

F3, copied down:

=IF(B3<>"",IF(((ISNUMBER(MATCH(B3,B4:$B$17,0))+ISNUMBER(MATCH(B3,$B$2:B2,0)))>0),LOOKUP(9.99999999999999E+307,$F$1:F2)+1,""),IF((B3="")*ISNUMBER(F2)*(F2>0),F2+1,""))

H1:

=LOOKUP(9.999999999999E+307,F1:F17)

H3, copied down:

=IF(ROW()-ROW($H$3)+1<=$H$1,MATCH(ROW()-ROW($H$3)+1,$F$3:$F$17,1),"")

I3, copied across to J2 then copied down:

=IF(N($H3),IF(INDEX(A$3:A$17,$H3)="","",INDEX(A$3:A$17,$H3)),"")

K3, copied across to M3 then down:

=IF(N($H3),INDEX(C$3:C$17,$H3),"")
 
Upvote 0
OH, thanks!!!!!!!!!!
great formulas!!!!!

Now I'have only to make a vba that'll do this work on all sheets.
(very simple).

After that i'll put on a race: my baka macro Vs yours
 
Upvote 0

Forum statistics

Threads
1,213,554
Messages
6,114,280
Members
448,562
Latest member
Flashbond

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.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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
Back
Top