Previous Topic Next Topic

VB issue with delete rows with specific values

Solved/Closed
weenie Posts 9 Registration date Saturday July 3, 2010 Status Member Last seen May 5, 2016 - Jan 13, 2013 at 01:58 PM
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 - 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

3 responses

Answer 1 / 3
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
Jan 13, 2013 at 03:15 PM
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
0
Answer 2 / 3
weenie Posts 9 Registration date Saturday July 3, 2010 Status Member Last seen May 5, 2016
Jan 13, 2013 at 08:02 PM
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
0
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
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
0
weenie
Jan 18, 2013 at 12:01 PM
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
0
weenie
Jan 19, 2013 at 06:28 PM
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
0
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
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
Answer 3 / 3
weenie
Jan 23, 2013 at 08:39 PM
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
0
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 766
Jan 23, 2013 at 09:36 PM
paste your full routine. May be some thing will show up
0

Similar discussions

help me to add particular cells
mathewmunna -
mathew munna -

2 responses
My Snapchat is not deleting
arpzz44 -
HelpiOS -

1 response
Fill adjacent cell with number from text answer
MitchP -
vcoolio -

20 responses