Deleting rows that contain numbers (a range) in column D

G

gimley

Hi all experts!

I'm new to vba and after some sources and modifications, I came up wit
the code below:

****************

Sub KeepCellId()
Dim myRows As Long
Dim Start_Num As Integer
Dim End_Num As Integer
'Start_Num = "10000"
'End_Num = "19999"

Range("A1").EntireColumn.Insert
Range("A1").FormulaR1C1 = _
"=IF(ISNUMBER(RC[4]),IF(AND(RC[4]>=VALUE(""10000"")," & _
"RC[4]<=VALUE(""19999"")), ""Trash"",""Keep""),""Trash"")"
myRows = ActiveSheet.UsedRange.Rows.Count
Range("A1").Copy Range("A1:A" & myRows)
With Range(Range("A1"), Range("A1").End(xlDown))
.Copy
.PasteSpecial Paste:=xlValues
End With
Cells.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending
Columns("A:A").Find(What:="Trash", After:=Range("A1")).Select

Range(Selection, Selection.End(xlDown)).EntireRow.Delete
Range("A1").EntireColumn.Delete

End Sub

****************

I have 2 problems with this code:

1. I do not wish to edit the first row (row #1) as this row contain
the headings of each column.

2. I wish to delete all rows that contains numbers ranging fro
(10000-19999, 40000-49999 and 61452-69999) in column D. The whole rang
of numbers is from 10000-69999.

All help will be greatly appreciated!! Thanks in advance
 
T

Tom Ogilvy

Dim myrows as Long
Dim cell as Range
set myrows = Cells(rows.count,4).End(xlup)
for i = myRows to 2 step -1
set cell = cells(i,4)
if isnumeric(cell) and not isempty(cell) then
if cell >= 10000 and cell <= 19999 _
or cell >= 40000 and cell <= 49999 _
or cell >= 64152 and cell <= 69999 Then
cell.EntireRow.Delete
end if
Else
cell.Entirerow.Delete
end if
Next

Untested
 
G

gimley

Thanks for your help!

When I try to run the code in excel 97, a compile error says "object
required" for line 3 "set myrows =..."

?? Please help thnks!


Tom said:
*Dim myrows as Long
Dim cell as Range
set myrows = Cells(rows.count,4).End(xlup)
for i = myRows to 2 step -1
set cell = cells(i,4)
if isnumeric(cell) and not isempty(cell) then
if cell >= 10000 and cell <= 19999 _
or cell >= 40000 and cell <= 49999 _
or cell >= 64152 and cell <= 69999 Then
cell.EntireRow.Delete
end if
Else
cell.Entirerow.Delete
end if
Next

Untested

--
Regards,
Tom Ogilvy


gimley > said:
Hi all experts!

I'm new to vba and after some sources and modifications, I came up with
the code below:

****************

Sub KeepCellId()
Dim myRows As Long
Dim Start_Num As Integer
Dim End_Num As Integer
'Start_Num = "10000"
'End_Num = "19999"

Range("A1").EntireColumn.Insert
Range("A1").FormulaR1C1 = _
"=IF(ISNUMBER(RC[4]),IF(AND(RC[4]>=VALUE(""10000"")," & _
"RC[4]<=VALUE(""19999"")), ""Trash"",""Keep""),""Trash"")"
myRows = ActiveSheet.UsedRange.Rows.Count
Range("A1").Copy Range("A1:A" & myRows)
With Range(Range("A1"), Range("A1").End(xlDown))
Copy
PasteSpecial Paste:=xlValues
End With
Cells.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending
Columns("A:A").Find(What:="Trash", After:=Range("A1")).Select

Range(Selection, Selection.End(xlDown)).EntireRow.Delete
Range("A1").EntireColumn.Delete

End Sub

****************

I have 2 problems with this code:

1. I do not wish to edit the first row (row #1) as this row contains
the headings of each column.

2. I wish to delete all rows that contains numbers ranging from
(10000-19999, 40000-49999 and 61452-69999) in column D. The whole range
of numbers is from 10000-69999.

All help will be greatly appreciated!! Thanks in advance!
Click to expand...
Click to expand...
 
T

Tom Ogilvy

sorry, that should be

myrows = Cells(rows.count,4).End(xlup).Row

--
Regards,
Tom Ogilvy


gimley > said:
Thanks for your help!

When I try to run the code in excel 97, a compile error says "object
required" for line 3 "set myrows =..."

?? Please help thnks!


Tom said:
*Dim myrows as Long
Dim cell as Range
set myrows = Cells(rows.count,4).End(xlup)
for i = myRows to 2 step -1
set cell = cells(i,4)
if isnumeric(cell) and not isempty(cell) then
if cell >= 10000 and cell <= 19999 _
or cell >= 40000 and cell <= 49999 _
or cell >= 64152 and cell <= 69999 Then
cell.EntireRow.Delete
end if
Else
cell.Entirerow.Delete
end if
Next

Untested

--
Regards,
Tom Ogilvy


gimley > said:
Hi all experts!

I'm new to vba and after some sources and modifications, I came up with
the code below:

****************

Sub KeepCellId()
Dim myRows As Long
Dim Start_Num As Integer
Dim End_Num As Integer
'Start_Num = "10000"
'End_Num = "19999"

Range("A1").EntireColumn.Insert
Range("A1").FormulaR1C1 = _
"=IF(ISNUMBER(RC[4]),IF(AND(RC[4]>=VALUE(""10000"")," & _
"RC[4]<=VALUE(""19999"")), ""Trash"",""Keep""),""Trash"")"
myRows = ActiveSheet.UsedRange.Rows.Count
Range("A1").Copy Range("A1:A" & myRows)
With Range(Range("A1"), Range("A1").End(xlDown))
Copy
PasteSpecial Paste:=xlValues
End With
Cells.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending
Columns("A:A").Find(What:="Trash", After:=Range("A1")).Select

Range(Selection, Selection.End(xlDown)).EntireRow.Delete
Range("A1").EntireColumn.Delete

End Sub

****************

I have 2 problems with this code:

1. I do not wish to edit the first row (row #1) as this row contains
the headings of each column.

2. I wish to delete all rows that contains numbers ranging from
(10000-19999, 40000-49999 and 61452-69999) in column D. The whole range
of numbers is from 10000-69999.

All help will be greatly appreciated!! Thanks in advance!
Click to expand...
Click to expand...
Click to expand...
 
G

gimley

Thanks Tom!

Your code works perfect. But a small thing.. I have over 4000 record
and it takes about 1 min to sort through the records. Was just thinkin
if it could be faster? Thanks
 
F

Frank Kabel

Hi
add the following to Tom's code:

sub delete_rows()
Dim myrows as Long
Dim cell as Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
myrows = Cells(rows.count,4).End(xlup).Row
for i = myRows to 2 step -1
set cell = cells(i,4)
if isnumeric(cell) and not isempty(cell) then
if cell >= 10000 and cell <= 19999 _
or cell >= 40000 and cell <= 49999 _
or cell >= 64152 and cell <= 69999 Then
cell.EntireRow.Delete
end if
Else
cell.Entirerow.Delete
end if
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
end sub
 
G

gimley

Hi Frank!

Thanks for you help!

The tables now never refresh until at the end, but the time taken i
still more than a min.

If I use my original code, it takes only about 3 secs to sort throug
the table. But the problem is that the code will delete the first ro
(that contains the word "cell_id" in column D) and I am not able to us
a few ranges of numbers. If you can help me modify my code, that wil
be the best!

Thanks so much in advance!

my original code:

Sub KeepCellId()
Dim myRows As Long
Dim Start_Num As Integer
Dim End_Num As Integer
'Start_Num = "10000"
'End_Num = "19999"

Range("A1").EntireColumn.Insert
Range("A1").FormulaR1C1 = _
"=IF(ISNUMBER(RC[4]),IF(AND(RC[4]>=VALUE(""10000"")," & _
"RC[4]<=VALUE(""19999"")), ""Trash"",""Keep""),""Trash"")"
myRows = ActiveSheet.UsedRange.Rows.Count
Range("A1").Copy Range("A1:A" & myRows)
With Range(Range("A1"), Range("A1").End(xlDown))
.Copy
.PasteSpecial Paste:=xlValues
End With
Cells.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending
Columns("A:A").Find(What:="Trash", After:=Range("A1")).Select

Range(Selection, Selection.End(xlDown)).EntireRow.Delete
Range("A1").EntireColumn.Delete

End Sub
 
T

Tom Ogilvy

Just change
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending
to

Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, _
header:=xlYes

--
Regards,
Tom Ogilvy


gimley > said:
Hi Frank!

Thanks for you help!

The tables now never refresh until at the end, but the time taken is
still more than a min.

If I use my original code, it takes only about 3 secs to sort through
the table. But the problem is that the code will delete the first row
(that contains the word "cell_id" in column D) and I am not able to use
a few ranges of numbers. If you can help me modify my code, that will
be the best!

Thanks so much in advance!

my original code:

Sub KeepCellId()
Dim myRows As Long
Dim Start_Num As Integer
Dim End_Num As Integer
'Start_Num = "10000"
'End_Num = "19999"

Range("A1").EntireColumn.Insert
Range("A1").FormulaR1C1 = _
"=IF(ISNUMBER(RC[4]),IF(AND(RC[4]>=VALUE(""10000"")," & _
"RC[4]<=VALUE(""19999"")), ""Trash"",""Keep""),""Trash"")"
myRows = ActiveSheet.UsedRange.Rows.Count
Range("A1").Copy Range("A1:A" & myRows)
With Range(Range("A1"), Range("A1").End(xlDown))
Copy
PasteSpecial Paste:=xlValues
End With
Cells.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending
Columns("A:A").Find(What:="Trash", After:=Range("A1")).Select

Range(Selection, Selection.End(xlDown)).EntireRow.Delete
Range("A1").EntireColumn.Delete

End Sub

Frank said:
*Hi
add the following to Tom's code:

sub delete_rows()
Dim myrows as Long
Dim cell as Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
myrows = Cells(rows.count,4).End(xlup).Row
for i = myRows to 2 step -1
set cell = cells(i,4)
if isnumeric(cell) and not isempty(cell) then
if cell >= 10000 and cell <= 19999 _
or cell >= 40000 and cell <= 49999 _
or cell >= 64152 and cell <= 69999 Then
cell.EntireRow.Delete
end if
Else
cell.Entirerow.Delete
end if
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
end sub
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

For Eachcell in Range tranpose comma seperated values to a list in D 4
File Name changes with dates and Deleting Rows of Zeros 0
Read a range into an array 9
How to write a for loop to get the range between a ,b columns 4
macro to copy rows that contain a cell with a certain number 2
Loop to determine number of rows range 1
Resize Range for Column 3
Copying Data Down the Column But Only Based on What's in Column A 1

Top