delete X rows after every blank row not including the first non-blank row

Jaffey · Jun 22nd 2012

I apologize in advance if my thread title sounds a bit nuts but please bear with me. I think you may agree it applies even if it does sound weird.

I ran a dupe file locator program across some drives and came up with 1000's of dupes. Below is a sample of the report showing the dupes which I dumped in excel. The dupe checker program will delete all the dupes leaving just the first instance of each file shown in the groupings below. What I would like is to take this report and delete all the extra rows of file names the same way the dupe checker is going to delete the files.

Once that is done I would like to move all the files to a single directory c:\sort for further sorting. This last step is considerably different than the first part of the problem so I'll understand if it needs to be posted later in it's own thread but if someone is up to the task I say thank you very much! Happy Friday to all.

File sample:

F:\Transcom\Lance\Business Plan\NCS Strategic Planning\10 POINT STRATEGIC PLANNING.pdf
F:\Transcom\Lance\Business Plan\NCS Strategic Planning\NCS Strategic Planning 2\10 POINT STRATEGIC PLANNING.pdf [<<delete this row]

E:\C drive\Documents and Settings\HP_Administrator.YOUR-4DACD0EA75\My Documents\Business\GOP\data source files\10,000 - 416's only less 1st 500.xls
F:\!My Docs backup\Business\GOP\data source files\10,000 - 416's only less 1st 500.xls [<<delete this row]
F:\old drives\1\My Documents\GOP\data source files\10,000 - 416's only less 1st 500.xls [<<delete this row]
F:\old drives\2\GOP3\data source files\10,000 - 416's only less 1st 500.xls [<<delete this row]
F:\Personal\GOP2\GOP\data source files\10,000 - 416's only less 1st 500.xls [<<delete this row]

E:\C drive\Documents and Settings\HP_Administrator.YOUR-4DACD0EA75\My Documents\condo dev lttr.doc
F:\!My Docs backup\condo dev lttr.doc [<<delete this row]
F:\Personal\condo dev lttr.doc [<<delete this row]

E:\C drive\Documents and Settings\HP_Administrator.YOUR-4DACD0EA75\My Documents\!Consulting\Consulting for Reliance\Confidentiality Agreement - Standard.doc
E:\C drive\Documents and Settings\HP_Administrator.YOUR-4DACD0EA75\My Documents\Legal\Confidentiality Agreement - Standard.doc [<<delete this row]
F:\!My Docs backup\!Consulting\Consulting for Reliance\Confidentiality Agreement - Standard.doc [<<delete this row]
F:\!My Docs backup\Legal\Confidentiality Agreement - Standard.doc [<<delete this row]
F:\deletable backups\!Consulting\Consulting for Reliance\Confidentiality Agreement - Standard.doc [<<delete this row]

F:\!!! TO USE AT CSC\CONFIDENTIALITY AGREEMENT feb1.doc
F:\LEGAL\CONFIDENTIALITY AGREEMENT feb1.doc [<<delete this row]

F:\!!! TO USE AT CSC\CONFIDENTIALITY AGREEMENT FOR SUPPLIERS.doc
F:\LEGAL\CONFIDENTIALITY AGREEMENT FOR SUPPLIERS.doc [<<delete this row]

jindon · Jun 23rd 2012

Re: delete X rows after every blank row not including the first non-blank row

Assuming the list in Col.A

Code

Sub test()
Dim rng As Range, r As Range, x As Range, fn As String
Set rng = Range("a1", Range("a" & Rows.Count).End(xlUp))
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For Each r In rng
            If r.Value <> "" Then
                fn = Mid$(r.Value, InStrRev(r.Value, "\") + 1)
                If Not .exists(fn) Then
                    .Item(fn) = Empty
                Else
                    If x Is Nothing Then
                        Set x = r
                    Else
                        Set x = Union(x, r)
                    End If
                End If
            End If
        Next
    End With
    If Not x Is Nothing Then x.Delete xlShiftUp
    Set rng = Nothing
    Set x = Nothing
End Sub

Display More

Jaffey · Jun 23rd 2012

Re: delete X rows after every blank row not including the first non-blank row

Worked like a charm. Thank you jindon!!

delete X rows after every blank row not including the first non-blank row

Participate now!

Share