macro which looks at excel 2008

[klobes01]

need a sub for looking at an excel document or *.xlsx file with about 700000 rows in sequential order by date/time stamp mm/dd/yyyy hh:mm:ss AM/PM

I need it to first look at column L where the timestamp is and for every duplicate timestamp in L, look at the text in A, and for everyone that has a duplicate value in L and a matching duplicate value in A, simply take the first one encountered.


A has a name and L has a timestamp

if L1 = L2 andalso if A1 = A2 then delete row 2
loop back to row 1 and run it again against row 3

if L1 <> L2 then move on row 2 and start again.


something like this. I'm trying to avoid only the situations where name and timestamp match on two or three or four or five different rows. I just want to take the first row of this type no matter what it is.

Please help.....sounds like a simple Do....While loop but I'm desperate.

 

[VoG]

Try

Sub DelDup()
Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = LR To 2 Step -1
    If Range("A" & i).Value = Range("A" & i - 1) And Range("L" & i).Value = Range("L" & i - 1).Value Then Rows(i).Delete
Next i
End Sub

 

[klobes01]

unfortunately this macro keeps running forever without stopping.

Is there possibly an infinite loop there.


I tried it on a small file to test and it keeps going.

 

[jasonb75]

Looking at the currrent UK time I would guess VoG has left the forum for the day, so hopefully this will help in his absence.

Try clicking in your macro (using your test file) then tap F8 until the yellow line is over the red text in this copy of the code.

Then hold your mouse cursor over the blue text and its current value will show.

Sub DelDup()
Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = LR To 2 Step -1
    If Range("A" & i).Value = Range("A" & i - 1) And Range("L" & i).Value = Range("L" & i - 1).Value Then Rows(i).Delete
Next i
End Sub

edit: * keep tapping F8 about 10 or so times after checking the value of i, then check it again, if it's unchanged then it means the code is stuck with deleting empty rows at the end of the sheet, and will need adjusting to compensate for this.

If the value is high, replace LR with 50 and run the test normally.

Note that this will not pick up any duplicate entries below row 50 in the sheet.

Once you're sure it's doing what it should, you can use the code on a COPY of your original file to clear out what you need it to.

I've added extra lines to VoG's code below to disable screen updating while the macro runs, this should spees up the proccess, although it will be slow for the amount of data you're working with.

It's also worth noting that the code will not pick up on duplicates in non-contiguous ranges, for example it would not delete anything if rows 2 and 4 had matching entries in both columns, but row 3 was different.

Sub DelDup()
Application.ScreenUpdating = False
Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = LR To 2 Step -1
    If Range("A" & i).Value = Range("A" & i - 1) And Range("L" & i).Value = Range("L" & i - 1).Value Then Rows(i).Delete
Next i
Application.ScreenUpdating = True
End Sub

Hope this helps.

 

[klobes01]

this works but runs really really slow. Is there anything else that will speed this up? Please. Thanks for all your help so far.

 

[jasonb75]

Maybe VoG will have some ideas how to speed up the code, a lot of it will depend on the amount of data it's got to run through and the system resources available to it.

I just autofilled a sheet with a large amount of data to test the code and it was proccessing around 2500 rows per minute.

 

[mikerickson]

Where does Excel2008 come into this question?

You might try seting Application.Calculation = xlManual/xlAutomatic in addition to the Application.ScreenUpdating=False/True.

700,000 is a lot of rows and it will take some time to look at all of them.

 

[ZVI]

Hi,
This should be much faster:

<font face=Courier New>
Sub DelDups()
  With Application
    ' Freeze On
    .Calculation = xlCalculationManual
    .EnableEvents = False
    .ScreenUpdating = False
    ' Set value=1 in aux column cells for each row to be deleted
    With ActiveSheet.UsedRange
      With .Columns(1).Resize(.Rows.Count - 1).Offset(1, .Columns.Count)
        .Formula = "=IF(AND(A2=A1,L2=L1),1,"""")"
        .Value = .Value
        Cells.Sort key1:=Cells(1, .Column), Order1:=xlAscending, Header:=xlYes
        .SpecialCells(xlCellTypeConstants).EntireRow.Delete
        .Clear
      End With
    End With
    ' Freeze Off
    .Calculation = xlCalculationAutomatic
    .EnableEvents = True
    .ScreenUpdating = True
  End With
  ' Reset last cell
  With ActiveSheet.UsedRange: End With
End Sub
</FONT>

Regards,
Vladimir