Getting There...Almost!!!

G

Gordon

Hi...

Thanks to those who have got the code below to where it
is.

This code launches the input box and will then go onto
delete all rows where the value in the input box was
found. Great!

However, if I don't enter a value and/or cancel the input
box the code below deletes every row where 0 occours.

How can I avoid this?

Public Sub remove()
Worksheets("Sheet1").Activate
Dim lastrow As Long
Dim lastcol As Long
Dim sString As String
sString = InputBox("ENETR YOUR VALUE: ANY ROW WHERE
THIS VALUE IS FOUND WILL BE DELETED")
lastrow = ActiveSheet.UsedRange.Rows.Count
lastcol = ActiveSheet.UsedRange.Columns.Count
Application.ScreenUpdating = False
Dim ir As Long, ic As Long, rd As Long
For ir = lastrow To 1 Step -1
For ic = lastcol To 1 Step -1
Cells(ir, ic).Activate
If UCase(Cells(ir, ic).Value) = UCase(sString) Then
Rows(ir).Delete shift:=xlUp
ir = ir - 1
ic = lastcol + 1
rd = rd + 1
End If
Next ic
Next ir
Application.ScreenUpdating = True
MsgBox "You have deleted: " & rd & " rows"
End Sub

Thanks in advance...

Gordon.
 
C

CoRrRan

Hi...

Thanks to those who have got the code below to where it
is.

This code launches the input box and will then go onto
delete all rows where the value in the input box was
found. Great!

However, if I don't enter a value and/or cancel the input
box the code below deletes every row where 0 occours.

How can I avoid this?

Public Sub remove()
Worksheets("Sheet1").Activate
Dim lastrow As Long
Dim lastcol As Long
Dim sString As String
sString = InputBox("ENETR YOUR VALUE: ANY ROW WHERE
THIS VALUE IS FOUND WILL BE DELETED")
lastrow = ActiveSheet.UsedRange.Rows.Count
lastcol = ActiveSheet.UsedRange.Columns.Count
Application.ScreenUpdating = False
Dim ir As Long, ic As Long, rd As Long
For ir = lastrow To 1 Step -1
For ic = lastcol To 1 Step -1
Cells(ir, ic).Activate
If UCase(Cells(ir, ic).Value) = UCase(sString) Then
Rows(ir).Delete shift:=xlUp
ir = ir - 1
ic = lastcol + 1
rd = rd + 1
End If
Next ic
Next ir
Application.ScreenUpdating = True
MsgBox "You have deleted: " & rd & " rows"
End Sub

Thanks in advance...

Gordon.

Gordon, add this after "sString = InputBox(..."

**************************************
If sString = "" Then
MsgBox "No search criteria requested.", vbOKOnly + vbInformation,
"Cancel is pressed."
Exit Sub
End If
**************************************

HTH,

CoRrRan
 
G

Guest

Hi...

Thanks for your help. Though the positioning your
additional code led to an IF error. I'm sure I've misread
your message. Could you intergrate your code into my code
and then send it back to me?

Much appreciated...

Gordon.
 
T

Tom Ogilvy

Your code is flawed in that you don't start at the first column when you
delete a row and you skip a row. I have added a line to fix the column bit
and checked the results of the inputbox. Also, there is no reason to
change the value of your loop index within the loop. I removed those lines.
Doing that is generally a bad practice anyway.

Public Sub remove()
Worksheets("Sheet1").Activate
Dim lastrow As Long
Dim lastcol As Long
Dim sString As String
sString = InputBox("ENTER YOUR VALUE: " & _
"ANY ROW WHERE THIS VALUE IS FOUND " & _
" WILL BE DELETED")
if len(trim(sStr))= 0 then exit sub
lastrow = ActiveSheet.UsedRange.Rows.Count
lastcol = ActiveSheet.UsedRange.Columns.Count
Application.ScreenUpdating = False
Dim ir As Long, ic As Long, rd As Long
For ir = lastrow To 1 Step -1
For ic = lastcol To 1 Step -1
Cells(ir, ic).Activate
If UCase(Cells(ir, ic).Value) = UCase(sString) Then
Rows(ir).Delete shift:=xlUp
rd = rd + 1
Exit For
End If
Next ic
Next ir
Application.ScreenUpdating = True
MsgBox "You have deleted: " & rd & " rows"
End Sub
 
C

CoRrRan

Your code is flawed in that you don't start at the first column
when you delete a row and you skip a row. I have added a line to
fix the column bit and checked the results of the inputbox. Also,
there is no reason to change the value of your loop index within
the loop. I removed those lines. Doing that is generally a bad
practice anyway.

Public Sub remove()
Worksheets("Sheet1").Activate
Dim lastrow As Long
Dim lastcol As Long
Dim sString As String
sString = InputBox("ENTER YOUR VALUE: " & _
"ANY ROW WHERE THIS VALUE IS FOUND " & _
" WILL BE DELETED")
if len(trim(sStr))= 0 then exit sub
lastrow = ActiveSheet.UsedRange.Rows.Count
lastcol = ActiveSheet.UsedRange.Columns.Count
Application.ScreenUpdating = False
Dim ir As Long, ic As Long, rd As Long
For ir = lastrow To 1 Step -1
For ic = lastcol To 1 Step -1
Cells(ir, ic).Activate
If UCase(Cells(ir, ic).Value) = UCase(sString) Then
Rows(ir).Delete shift:=xlUp
rd = rd + 1
Exit For
End If
Next ic
Next ir
Application.ScreenUpdating = True
MsgBox "You have deleted: " & rd & " rows"
End Sub

I disagree with you Tom. It might be 'bad practice', but I have run
this program and found that if the row is deleted, the code starts to
check a row that has already been checked. Which is of course double
work and can cause delays, especially with 10,000 rows and 100+
columns. I recon that the modification of the loop index is beneficial
to this procedure.

Oh, and you have created an error in the code. Gordon, here is my
version of the code, including Tom's if-statement, written 'correctly':
************************************************
Sub remove()

Dim lastrow As Long, lastcol As Long
Dim sString As String
Dim ir As Long, ic As Long, rd As Long

Worksheets("Sheet1").Activate

sString = InputBox("ENTER YOUR VALUE: ANY ROW WHERE THIS VALUE IS
FOUND WILL BE DELETED")

If Len(Trim(sString))= 0 Then Exit Sub
' ^^^^^^^ changed to correct variable
lastrow = ActiveSheet.UsedRange.Rows.Count
lastcol = ActiveSheet.UsedRange.Columns.Count

Application.ScreenUpdating = False

For ir = lastrow To 1 Step -1
For ic = lastcol To 1 Step -1
Cells(ir, ic).Activate
If UCase(Cells(ir, ic).Value) = UCase(sString) Then
Rows(ir).Delete Shift:=xlUp
ir = ir - 1
ic = lastcol + 1
rd = rd + 1
End If
Next ic
Next ir

Application.ScreenUpdating = True

MsgBox "You have deleted: " & rd & " rows."

End Sub
***********************************************

Perhaps using the "Find" function of VBA can be a better solution, but
for a quick solution, I think this will work ok.

HTH,
CoRrRan
 
C

CoRrRan

Hi...

Thanks to those who have got the code below to where it
is.

This code launches the input box and will then go onto
delete all rows where the value in the input box was
found. Great!

However, if I don't enter a value and/or cancel the input
box the code below deletes every row where 0 occours.

How can I avoid this?

Public Sub remove()
Worksheets("Sheet1").Activate
Dim lastrow As Long
Dim lastcol As Long
Dim sString As String
sString = InputBox("ENETR YOUR VALUE: ANY ROW WHERE
THIS VALUE IS FOUND WILL BE DELETED")
lastrow = ActiveSheet.UsedRange.Rows.Count
lastcol = ActiveSheet.UsedRange.Columns.Count
Application.ScreenUpdating = False
Dim ir As Long, ic As Long, rd As Long
For ir = lastrow To 1 Step -1
For ic = lastcol To 1 Step -1
Cells(ir, ic).Activate
If UCase(Cells(ir, ic).Value) = UCase(sString) Then
Rows(ir).Delete shift:=xlUp
ir = ir - 1
ic = lastcol + 1
rd = rd + 1
End If
Next ic
Next ir
Application.ScreenUpdating = True
MsgBox "You have deleted: " & rd & " rows"
End Sub

Thanks in advance...

Gordon.

Gordon,

I have been looking at another code, which you might want to have a
look at. It does do what you are looking for, and is quite fast. It was
posted by Harald Staff in your previous thread:

*************************
Sub KillRows()

Dim Cell As Range
Dim sFind As String
Dim l As Long

Do
sFind = InputBox("Delete rows with:", _
l & " rows deleted so far")
If sFind = "" Then Exit Do
Do
Set Cell = Nothing
On Error Resume Next
Set Cell = Cells.Find(What:=sFind, _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
MatchCase:=False)
If Cell Is Nothing Then Exit Do
Cell.EntireRow.Delete
l = l + 1
Loop Until Cell Is Nothing
Loop Until sFind = ""
MsgBox l & " rows deleted"

End Sub
*************************

This solution removes the necessity to run through all the cells in
your range and doing so, it works probably faster.

HTH,
CoRrRan
 
T

Tom Ogilvy

Typo
change
if len(trim(sStr))= 0 then exit sub

to

if len(trim(sString))= 0 then exit sub
 
T

Tom Ogilvy

I misread your code, so I stand corrected on missing cells, but jumping out
of the inner loop is the better approach in my opinion.
 

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

Top