If, Then, Cut, Paste, Delete HELP

[stephanie spomer]

I am trying to do the following (semi-pseudocode):

Dim row, column
For row = 2 and column = B
If B2 = 16210 Then
Cut cells B2:V2
row = row -1
column = F
paste cells
row = row+1
delete row
column = B
ElseIf B2 = "PO" Then
delete row
row = row + 1
End If
End For

That is what i'm trying to accomplish, this is what i have so far:

Sub FixOpenOrders()
Dim topCel As Range, bottomCel As Range, _
sourceRange As Range, targetRange As Range
Dim x As Integer, i As Integer, numofRows As Integer
Set topCel = Range("B2")
Set bottomCel = Range("B65536").End(xlUp)
Set sourceRange = Range(topCel, bottomCel)
Set targetRange = Range("F1, Z1")
numofRows = sourceRange.Rows.Count
x = 1
For i = 1 To numofRows
If Application.IsNumber(sourceRange(i)) Then
If sourceRange(i) = 16210 Then
targetRange(x) = sourceRange(i)
x = x + 1
ElseIf sourceRange(i) = "PO" Then
sourceRange(i).Rows.Select
Selection.Delete Shift:=xlUp
x = x + 1
End If
End If
Next
End Sub

Any help is appreciated



*** Sent via Developersdex http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!

 

[Dick Kusleika]

Stephanie

When you delete rows in a loop, you need to work from the bottom up, as
described here

http://www.dicks-blog.com/excel/2004/05/loop_to_delete_.html

The problem that I see is if you have a PO row directly above a 16210 row,
then you will copy the 16210 row to the PO row, then delete the PO row. I
guess that's not what you want. Maybe you could provide a few rows of
sample data. Here's some code with the aforementioned problem in it.

Sub FixOpenOrders()

Dim lRow As Long
Dim lStartRow As Long

With ActiveSheet
lStartRow = .Range("B" & .Rows.Count).End(xlUp).Row

For lRow = lStartRow To 2 Step -1
With .Cells(lRow, 2)
If .Value = 16210 Then
.Resize(1, 21).Copy _
Destination:=.Offset(-1, 4)
.EntireRow.Delete
ElseIf .Value = "PO" Then
.EntireRow.Delete
End If
End With
Next lRow
End With

End Sub