Hi,

win2k
excel2k

Here is my dilemma:

On Sheet1 I have a space: range b6 : n30. Most columns with that space contain information, but only some must remain after clearing the space if column d contains an ‘X”. The problem is after cleaning up the space.

For a better definition of the space, please see attachments. The attachments are to *.bmp files. Sheet.bmp represents the state of the sheet after clean up but before moving the rows upward. Sheet2.bmp represents the final product. That is where the rows should be when done.

My problem is that once the space is cleared, then I need to move all the rows from within the space upward all the way up to b6 and accumulating downward for as many as there are.

Here is my code, which is not very good. While it moves some rows depending on some conditions, the variety of possibility is so great that I cannot account for all of them. I have to copy, move up but if the row above is empty then ok paste but if the row above is not empty then move up one more, and so one…. I know about KISS and I want to keep it simple and I am sure there is a better way to do this. That is why I am writing this for help.

this is my code:

It starts at the bottom and goes upward to pick up the first cell that contains an 'x'. if so then it copies it and then moves upward to all the way up to cell B6. if B6 is empty then paste it, else go down one cell at the time until the first empty cell and the paste it. then using the "count" go back down to the copied cell and clear it. go upone row and restart the process all over again.

Private Sub CommandButton1_Click()
Dim irowcount As Integer
Dim r As Integer
Dim i As Integer
Dim count As Integer
With ActiveSheet
irowcount = 30
For r = irowcount To 1 Step -1 'from the bottom up
If r = 6 Then
Exit Sub
End If
Range("d" & r).Select
If Range("d" & r).Value = "X" Then
Range("b" & r & ":n" & r).Select
Selection.Copy 'copy and move up
Range("b" & r).Offset(-1, 0).Select
r = r - 1
count = 1
For i = 25 To 1 Step -1
If Range("b" & r).Value <> "" And r <> 6 Then
Range("b" & r & ":n" & r).Offset(-1, 0).Select
r = r - 1
count = count + 1 'as loop moves upward count 1 so that it can find the copied cell on the way down.
ElseIf Range("b" & r).Value = "" And r <> 6 Then
Range("b" & r & ":n" & r).Offset(-1, 0).Select
r = r - 1
count = count + 1
ElseIf Range("b" & r).Value = "" And r = 6 Then
Range("b" & r & ":n" & r).Offset(1, 0).Select
r = r + 1
If Range("b" & r).Value = "" Then
ActiveSheet.Paste
Application.CutCopyMode = False
End If
ElseIf Range("b" & r).Value <> "" And r = 6 Then
Dim j As Integer
For j = 1 To count
'Range("b" & r & ":n" & r).Offset(1, 0).Select
'r = r + 1
If Range("b" & r).Value = "" Then
ActiveSheet.Paste 'paste and exit this for loop
Application.CutCopyMode = False
Exit For
Else
Range("b" & r & ":n" & r).Offset(1, 0).Select
r = r + 1
count = count - 1
'Exit For
End If
Next j
Dim jj As Integer
For jj = 1 To count 'now go down to clear the copied cell range
Range("B" & r).Select
Range("b" & r).Offset(1, 0).Select
r = r + 1
If jj = count Then
'r = r - 1
Range("b" & r & ":n" & r).Clear
Range("b" & r & ":n" & r).Offset(-1, 0).Select
r = r - 1
Exit For
End If
Next jj
Exit For
End If
Next i
End If
If r = 6 Then
Exit Sub
End If
Next r
End With
End Sub



ps: sometime i see some of you post code in a window that is better to read. How does one do that on DBFORUM??

Hi Alex

is this the sort of thing you want

we can do more if required this code picks the first cell in column D with an X in it and then pastes it into the first blank area in your area

if you just want to keep the same order it's already in you can just do this

oh and to get the code window up type [ code ] at the start of your code and [ /code ] at the end of your code (witout the spaces)

HTH
Dave

Hi,

Thank you for you help. Your code is by far, simpler, clearner, definetly shorter and efficient.

I eventually got my to work, but it is far longer harder to ready and less efficient.