VB issue with delete rows with specific values [Solved/Closed]

Posts
10
Registration date
Saturday July 3, 2010
Last seen
May 5, 2016
- Jan 13, 2013 at 01:58 PM - Latest reply:
Posts
4481
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
- Jan 23, 2013 at 09:36 PM
Hello,

I am using 2007 excel and have the VB doing 2 things:
1) looking at specific Column for EXACT values and deleting row
2) looking at specific Column for ALL OTHER values EXCEPT specified and delete row

I think issue is amount of row having to look through 500K +. It hangs up and takes a VERY LONG TIME to run this portion. If I am lucky it will finish in a few hours but most of time it crashes. Is there a way to modify code to run faster when executing this portion of code? Any help would be much appreciated.

Here is code for both instances:

INSTANT#1
Sub RawData()
Dim rng As Range, Cell As Range, del As Range 'For Deleting

'TO DELETE ROWS WITH EXACT VALUES ENTERED BELOW for "Raw DATA SHEET"
'We turn off calculation and screenupdating to speed up the macro.

With Application

.Calculation = xlCalculationManual

.ScreenUpdating = False

Worksheets("Raw Data").Activate
Set rng = Intersect(Range("M2:M" & Rows.Count), ActiveSheet.UsedRange)
For Each Cell In rng
If (Cell.Value) = "1E+17" _
Or (Cell.Value) = "1.0E+17" _
Or (Cell.Value) = "100000000000000000" _
Or (Cell.Value) = "1E-17" _
Or (Cell.Value) = "1.0E-17" _
Or (Cell.Value) = "0.00000000000000001" _
Or (Cell.Value) = "1E+30" _
Or (Cell.Value) = "1.0E+30" _
Or (Cell.Value) = "1.50E+30" _
Or (Cell.Value) = "1.5E+30" _
Or (Cell.Value) = "0.00E+00" Then
If del Is Nothing Then
Set del = Cell
Else: Set del = Union(del, Cell)
End If
End If
Next Cell

On Error Resume Next
del.EntireRow.Delete

.Calculation = xlCalculationAutomatic

.ScreenUpdating = True
End With
End Sub

INSTANT#2
Sub RemoveData()
'TO DELETE ALL ROWS EXCEPT VALUES BELOW FROM "FAILURE DATA SHEET"
Dim rng As Range, Cell As Range, del As Range 'For Deleting

'We turn off calculation and screenupdating to speed up the macro.

With Application

.Calculation = xlCalculationManual

.ScreenUpdating = False
Worksheets("Failure Data").Activate
Set rng = Intersect(Range("M2:M" & Rows.Count), ActiveSheet.UsedRange)
For Each Cell In rng
If (Cell.Value) = "1E+17" _
Or (Cell.Value) = "1.0E+17" _
Or (Cell.Value) = "100000000000000000" _
Or (Cell.Value) = "1E-17" _
Or (Cell.Value) = "1.0E-17" _
Or (Cell.Value) = "0.00000000000000001" _
Or (Cell.Value) = "1E+30" _
Or (Cell.Value) = "1.0E+30" _
Or (Cell.Value) = "1.50E+30" _
Or (Cell.Value) = "1.5E+30" _
Or (Cell.Value) = "0.00E+00" Then
Else
If del Is Nothing Then
Set del = Cell
Else: Set del = Union(del, Cell)
End If
End If
Next Cell

On Error Resume Next
del.EntireRow.Delete
del.EntireRow.Delete

.Calculation = xlCalculationAutomatic

.ScreenUpdating = True
End With
End Sub


Thanks,
Weenie
See more 

8 replies

Posts
4481
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
- Jan 13, 2013 at 03:15 PM
0
Thank you
Try this. instead of adding to range, have a temp column where you put 1, if true and 0 if false
Then filter on appropriate condition
delete all visible rows
Posts
10
Registration date
Saturday July 3, 2010
Last seen
May 5, 2016
- Jan 13, 2013 at 08:02 PM
0
Thank you
Tyring to figure out what I have wrong keep getting Syntax error. When I run just 1 criteria works like a charm as you stated to add 1 for true in a temp column. So, I figured works with 1 criteria I can expand on criteria aditions but no dice.

Sub fig1()
' To look up a value in a col. then enter a 1=true on next column

Dim LR As Long, I As Long
With Sheets("Raw Data")
LR = .Range("M" & Rows.Count).End(xlUp).Row
For I = 2 To LR
**this is area has syntax error** If .Range("M" & i).Values = "1E+17", "1E-17" , "1E+30", "1.5E+30","1" And .Range("N" & i).Value = "" Then
With .Range("N" & i)
.Value = "1"
End With
End If
Next i
End With
End Sub

Thanks,
Weenie
Posts
4481
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
- Jan 13, 2013 at 09:30 PM
try this

    With Range(Cells(2, "N"), Cells(lr, "N"))
        .NumberFormat = "general"
        .FormulaR1C1 = "=if(rc[-1]="""",0,IF(OR(RC[-1]=1E+17,RC[-1]=0,RC[-1]=1E-17,RC[-1]=1E+30,RC[-1]=1.5E+30),1,0))"
        Application.CutCopyMode = False
        .Copy
        .PasteSpecial xlPasteValues
        Application.CutCopyMode = False
    End With
Thanks. It works like a charm and fast. But I have another issue I have read up on autofilter & making it visible cells only to copy and paste to different sheet. I am having a problem with it copying and pasting. At your suggestion I made a temp column and did 0 & 1. I want to take it a step further: filter by selecting 1's only, copy non-contigious rows to different sheet2, go back to orginal sheet1 and delete rows of the 1's criteria.

ActiveSheet.Range("$A$1:$N$200000").AutoFilter Field:=14, Criteria1:="1"
'Offset 1 Row to exclude headings
Set FilterRange = ActiveSheet.UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible)
FilterRange.Copy Destination:=Sheets("Failure Data").Range("A2")

'We use the ActiveSheet since has the data we want to delete
With Sheets("Raw data")

'Set the first and last row to loop through row start at & the column you want to look at
Firstrow = 2
Lastrow = Cells(Rows.Count, "N").End(xlUp).Row

'We loop from Lastrow to Firstrow (bottom to top)
For Lrow = Lastrow To Firstrow Step -1

'We check the Name WE WANT DELETED in the column in this example
With Cells(Lrow, "N")

If Not IsError(.Value) Then

If .Value = "1" Then .EntireRow.Delete
'This will delete each row with the Value
End If

End With

Next Lrow

End
So I was curious as to many records I have of "1" criteria from autofilter results. It showed I had 25,240 records from total 194,401 (number rows will always vary for each file I have to run). I keep getting error not sure as to why. From what I have noticed is 8179 instances is max "areas" will allow and I'm sure amount I have is exceeding. I havent attempted to delete the filtered rows since I can not even manage to paste the 25,240 rows of filtered criteria without it pasting ALL rows filtered & non-filtered.I tried recoding macro steps of copying or deleting filtered rows and I get error of area/rectangle and will proceed to either copy/delete all. Majorly stuck any help be appreciated

Sub TryAutoFilter()
Dim worksheet1 As Worksheet
Set worksheet1 = Worksheets("Raw Data")

With worksheet1
.AutoFilterMode = False: .Rows(1).AutoFilter
.Rows(1).AutoFilter Field:=CStr(14), Criteria1:="=1"
**Next line below is where I get error**
If .AutoFilter.Range.Columns(14).SpecialCells(xlCellTypeVisible).Count - 1 = 1 Then
.Range("A1").CurrentRegion.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy _
Destination:=Worksheets("Sheet3").Range("A1")
Else
MsgBox "No data to copy"
End If

.AutoFilterMode = False

End With

End Sub
Thanks,
Weenie
Posts
4481
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
- Jan 21, 2013 at 08:23 PM
I am not sure what you asked later. You dont have to delete row by row,

try this

Sub fig1()
' To look up a value in a col. then enter a 1=true on next column

Dim LR As Long, I As Long
Dim lastColumn As Long

   With Sheets("Raw Data")
      .AutoFilterMode = False
      LR = .Range("M" & Rows.Count).End(xlUp).Row
      lastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
       With Range(Cells(2, "N"), Cells(LR, "N"))
           .NumberFormat = "general"
           .FormulaR1C1 = "=if(rc[-1]="""",0,IF(OR(RC[-1]=1E+17,RC[-1]=0,RC[-1]=1E-17,RC[-1]=1E+30,RC[-1]=1.5E+30),1,0))"
           Application.CutCopyMode = False
           .Copy
           .PasteSpecial xlPasteValues
           Application.CutCopyMode = False
       End With
       
       'you should select all cells rather as range as on times empty cells cause issues
       .Cells.AutoFilter Field:=14, Criteria1:="1"
       Application.CutCopyMode = False
       .Range(.Cells(2, 1), .Cells(LR, lastColumn)).Copy
       Sheets("Failure Data").Range("A2").PasteSpecial
       Application.CutCopyMode = False
       .Range(.Cells(2, 1), .Cells(LR, lastColumn)).EntireRow.Delete
        .AutoFilterMode = False
   End With
End Sub
0
Thank you
I keep getting Run-time error '1004':
Application-defined or object-defined error where I placed asterisk. Not sure why error since the top half code you supplied works

'you should select all cells rather as range as on times empty cells cause issues
.Cells.AutoFilter Field:=14, Criteria1:="1"
Application.CutCopyMode = False
***** .Range(.Cells(2, 1), .Cells(LR, lastColumn)).Copy
Sheets("Failure Data").Range("A2").PasteSpecial
Application.CutCopyMode = False
.Range(.Cells(2, 1), .Cells(LR, lastColumn)).EntireRow.Delete
.AutoFilterMode = False
End With
Thanks,
Weenie
Posts
4481
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
January 6, 2016
- Jan 23, 2013 at 09:36 PM
paste your full routine. May be some thing will show up