Need Help with Next thing

  • Thread starter Thread starter ksnapp
  • Start date Start date
K

ksnapp

Here is the code:

Sub Delete_Pork_in_string() ' deltes rows with reserve in column 3
Application.ScreenUpdating = False
Const cColumn = 2, cSearch = "PORK"
Dim I As Long, lngLastRow As Long
With ActiveSheet
lngLastRow = .Cells(Rows.Count, cColumn).End(xlUp).Row
For I = lngLastRow To 1 Step -1
If InStr(1, .Cells(I, cColumn).Value, cSearch) > 0 Then
If Not IsEmpty(Cells(I, "A")) Then
Cells(I + 1, "A").Value = Cells(I, "A").Value
End If
Rows(I).Delete xlShiftUp
End If
Next
End With
Application.ScreenUpdating = True
End SuB

the problem I'm having is that when it deletes a row that meets th
criteria it goes to next cell, which means that it skips one.

If i have a bunch of these cells that meet the criteria in a contigou
range down the column I only get rid of 1/2 of em.


any way to fix this or make a whole sub repeat itself a number o
times
 
Hi!

I haven't tried to replicate your situation. However, the line Cells(
+ 1, "A").Value = Cells(I, "A").Value looks a bit suspicious becaus
you seem to be going down the list when the overall loop is going up
Worth a look: maybe it should be I-1?


Al
 
I'm not able to reproduce your results. In my test workbook, every cell
in column B that contains "PORK" is deleted.

By going from highest numbered row to 1 you avoid the problem of
skipping rows...

Have you stepped through this to see what's happening?
 
I am not seeing your problem. I had a whole set of contiguous PORK rows, and
they all got deleted in one run of the macro.

You are deleting bottom up which is the right way, so that is not a problem.

Can you be more specific?

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
I posted the wrong sub


Sub Singular_pork() ' cleans up based on whats in the discription
Application.ScreenUpdating = False
Dim rw
rw = Cells(Rows.Count, 3).End(xlUp).Row
Range("c3", Cells(rw, 3)).Select

For Each CELL In Selection

If CELL.Value = "PORK" And CELL.Offset(0, 1).Value <= 1 Then
If CELL.Offset(0, -2) <> Empty Then
CELL.Offset(1, -2).Value = CELL.Offset(0, -2).Value
CELL.EntireRow.Delete
Else
CELL.EntireRow.Delete
End If
End If

Next
Application.ScreenUpdating = True
End Su
 
One way:


Public Sub Singular_pork()
'cleans up based on what's in the description
Const sDESCRIPTION = "PORK"
Dim rDelete As Range
Dim rCell As Range

For Each rCell In Range("C3:C" & _
Range("C" & Rows.Count).End(xlUp).Row)
With rCell
If .Value = sDESCRIPTION And .Offset(0, 1).Value <= 1 Then
If Not IsEmpty(.Offset(0, -2).Value) Then _
.Offset(1, -2).Value = .Offset(0, -2).Value
If rDelete Is Nothing Then
Set rDelete = rCell
Else
Set rDelete = Union(rDelete, rCell)
End If
End If
End With
Next rCell
If Not rDelete Is Nothing Then rDelete.EntireRow.Delete
End Sub
 
What about trying, its a bit basic but it should give you a starter
Enjoy,

Marc

Sub no_pork()
Application.ScreenUpdating = False

On Error Resume Next
With ActiveSheet
Range("a1:a25000").Activate
For Each rngcell In Selection
If UCase(rngcell.Value) Like "PORK" Then
Rows(rngcell.Row).Delete

Else
End If

Next rngcell
End With
Application.ScreenUpdating = True
End Sub
 
Why not use the sub you posted - it works!

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Not for cases where two or more contiguous cells have the target. Or did
you mean the original one? That one used a different column, checked for
the search term anywhere in the text of the cell, and didn't have the
..Offset(0, 1).Value <=1 criterion, but otherwise was functional.

However, given the similarity of this question with another post that
had an awfully similar setup, it's tempting to think that a homework
assignment may have been involved.
 
Actually all these questions relate to work projects that I was utterl
unqualified to take on, but now thanks to you fine people its al
pretty much done, and I have all this knowlege for then next thing tha
gets trown my wa
 
Back
Top