Big sheet, need a way to delete fast

[Spurious]

Hello,

the following:

I got a sheet with ~15000 rows, I sort them first and then I go from the last to the first and delete if the input in column 5 is the same as in the row above, additionally I add the values in column 12.

Now, this takes forever. I takes me roughly 2.5 minutes to do it for 250 rows.

Do While i > i
    If Sheet.Cells(i, Clm) = Sheet.Cells(i - 1, Clm) Then
        Sheet.Cells(i - 1, 12) = Sheet.Cells(i - 1, 12) + Sheet.Cells(i, 12)
        Sheet.Range(Cells(i, 1), Cells(i, 25)).Delete xlShiftUp
    End If
    
    i = i - 1
Loop

Is there a faster way to do this?

Thanks in advance!

 

[Rick Rothstein]

The OP is creating a summary by summing the values in column 12 for each unique item and deleting the duplicates.

Okay, I get it now. Thanks!

 

[Rick Rothstein]

Not sure if this code does what I need it to do. I dont really understand it, but it seems like it deletes the entire row if there is a duplicate, but doesnt add the values in column 12.

I think I see what want now. Give this code a try...

Sub RemoveDupes()
  Dim UnusedColumn As Long, LastRow As Long
  UnusedColumn = Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Column + 1
  LastRow = Cells(Rows.Count, "E").End(xlUp).Row
  On Error Resume Next
  Application.ScreenUpdating = False
  With Cells(2, UnusedColumn).Resize(LastRow - 1)
    .FormulaR1C1 = "=IF(RC5=R[-1]C5,""x"","""")"
    .Value = .Value
    .Offset(, 1).FormulaR1C1 = "=IF(RC5=R[1]C5,RC12+R[1]C,RC12)"
    .Offset(, 1).Value = .Offset(, 1).Value
    Range("L1:L" & LastRow).Value = Cells(1, UnusedColumn + 1).Resize(LastRow).Value
    .SpecialCells(xlCellTypeConstants).EntireRow.Delete
  End With
  Columns(UnusedColumn + 1).Clear
  Application.ScreenUpdating = True
End Sub

 

[Spurious]

  Dim UnusedColumn As Long, LastRow As Long
  UnusedColumn = Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Column + 1
  LastRow = Cells(Rows.Count, Clm).End(xlUp).Row
  On Error Resume Next
  Application.ScreenUpdating = False
  With Cells(2, UnusedColumn).Resize(LastRow - 1)
    .FormulaR1C1 = "=IF(RC5=R[-1]C5,""x"","""")"
    .Value = .Value
    .Offset(, 1).FormulaR1C1 = "=IF(RC5=R[1]C5,RC12+R[1]C,RC12)"
    .Offset(, 1).Value = .Offset(, 1).Value
    Range("L1:L" & LastRow).Value = Cells(1, UnusedColumn + 1).Resize(LastRow).Value
    .SpecialCells(xlCellTypeConstants).EntireRow.Delete
  End With
  Columns(UnusedColumn + 1).Clear

I need every 5 replaced with a "Clm", because I use more than one column.
How would I do this?

In any event, thank you, I'll try it and report back.

 

[Spurious]

false alarm

 

[Spurious]

Sorry, false alarm.

It doesnt get everything. It misses a lot of values.
There is some mistake in there. It has 0s, negative values and sometimes no values, which is never the case in the sample.

 

[Spurious]

Anyone?

Column 5 works fine, but the calculated values are wrong.

 

[Rick Rothstein]

Anyone?

Sorry... I had gone to sleep for the night.

Column 5 works fine, but the calculated values are wrong.

If you are talking about the code I posted, then I'm not sure what to tell you since the code worked for the sample data I made up. In order to trace what might be going wrong, I will need to see your actual workbook with its real data. It would be better to have as many eyes looking at your problem as possible (in case others have a different approach to the problem than I have), so would it be possible for you to post the workbook on one of the free file sharing websites on the Internet. If so, you can post it online using one of these free posting websites...

Box: http://www.box.net/files
MediaFire: http://www.mediafire.com
FileFactory: http://www.filefactory.com
FileSavr: http://www.filesavr.com
FileDropper: http://www.filedropper.com
RapidShare: http://www.rapidshare.com

Then post the URL they give you for the file back here.

If you are reluctant to post it that way, you can send the workbook directly to me at rickDOTnewsATverizonDOTnet (replace the upper case letters with the symbols they spell out).

 

[Spurious]

I worked it out (sent you a pm), but thank you again! Had to change a few parameters.