Efficient coding: Deleting lines

[obiron]

hi guys,

I have inherited a VBA script which takes a worksheet (44K rows) and as part of its validation checks to see if an asset ID appears on more than one row using the countif function

    If Cells(ActiveCell.Row, chChargeGroup) = "RENT" And WorksheetFunction.CountIf(Range(Cells(2, chU001_AssetRef), Cells(LastRow, chU001_AssetRef)), Selection) = 2 Then

Originally it was deleting the line as it went through the loop. I have changed this to setting a value and then at the end of the loop autofiltering on the value and deleting the lines on masse. Is there a more efficient way to check if the assetRef appears more than once?

I am thinking maybe using autofilter and counting the displayed rows but I am struggling to make specialcells(xlCellTypeVisible) play nicely with the other children.

 

[venkat1926]

it is not clear what you want to do

let me rephrase
you have 44k rows data.
in one column "x" appears a no. of time
then waht?
do you want to delete all the rows where x occurs
or
do you want to delete all rows except first where x occurs.

give a few example

your line of thinking is correct. autofilter and delete the rows.

if you explain with small examples it would be possible to help you with "spcial cells"

 

[Norie]

You could put a formula in each row that will indicate if there's more than one instance of the Asset No.

This will put a COUNTIF formula in the column to the right the column which I think has the asset numbers, chU001_AssetRef.

Cells(2, chU001_AssetRef).Offset(,1).Resize(LastRow - 1).FormulaR1C1 = "=COUNTIF(R2C[-1]:RC[-1]  ,RC[-1])"

The formula will return 1 if the Asset No is the first instance in the list, 2 if it's the 2nd and so on.

Not 100% sure what you want to do next but it would be easy to add another formula to count the Asset Nos that appear more than once.

 

[obiron]

thanks for the replys guys,

The assetref appears 1..n times in column A with a different charge type in Col F. I want to delete the row if the assetref appears more than once and the charge type is "RENT". the problem is that the assetref records may not appear together in a block.

I have tried this four different ways and the results are below.

using worksheetfunction.countif() in VBA - SLOW!!!
range.formulaR1C1 = "countif(....)" - Even slower as it recalcs all the time
using autofilter - still very slow, was going to take over 4 hours

final method
Sort the data by assetref and charge type
range.formulaR1C1 = "if(AND(RC[-10] = "RENT"),OR(R[1]C[-16] = RC-16,R[-1]C[-16] = RC[-16]),"DEL","")
(if this row = RENT and the assetref matches the asset ref in the row above or below, mark the row for deletion)
Copy and paste special->values only
sort the data by the DEL column
autofilter
set the range to row2:lastrow
selection.specialcells(xlCellTypeVisible).EntireRow.Delete

result: almost instant....

I am fortunate in that the worksheet has no other formulas in it (it was imported from another file) and the sequence of the records is of no consequence so I can deploy the sort quite freely - other people may not be so lucky.

Actual code

Range(Cells(1, 1), Cells(LastRow, chError)).Select
    Selection.Sort Key1:=Range(Cells(1, 1).Address), Order1:=xlAscending, Key2:=Range(Cells(1, chChargeGroup).Address) _
        , Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False _
        , Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:= _
        xlSortNormal
 
    Range(Cells(2, chError), Cells(LastRow, chError)).Select
    Selection.FormulaR1C1 = _
        "=IF(AND(RC[-96]=""RENT"",OR(RC[-101]=R[-1]C[-101],RC[-101]=R[1]C[-101])),""DEL"","""")"
 
    'copy and paste back values
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
 
    'sort data by deletion
    Cells(1, chError) = "To Delete"
    Columns(chError).Select
    Range(Selection, Cells(ActiveCell.Row, 1)).Select
    Application.CutCopyMode = False
    Selection.Sort Key1:=Range(Cells(2, chError).Address), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNorma
 
    ' autofilter and delete the rows
    Columns(chError).Select
    Selection.AutoFilter field:=1, Criteria1:="DEL"
    Range(Cells(2, chError), Cells(LastRow, chError)).Select
    Selection.SpecialCells(xlCellTypeVisible).EntireRow.Delete
    ActiveSheet.AutoFilterMode = False
    Range(Cells(1, 1).Address).Select
 
    'reset last row calculator
    Selection.End(xlDown).Select
    LastRow = ActiveCell.Row

just noticed that the code needs some enhancement chError is column CX (col#102) and the formula has [-101] as a hard coded offset. this needs to be replaced with a calculated offset between chError and the column number for assetref