I have a list of people who have departments ranging from 3811-3933.
I'm trying to sort everything so that at the top of the list are all the employees with the dept numbers 3831 until 3843, then a blank row and then everyone else. Since the rows appear in department order, the loop can stop once it reaches department 3844. So far this is what I've come up with, but it doesn't work.
If possible, I would also like to take the rows with department 3827 and paste that at the bottom of the top half (3831-3843)
The rows of people start at row 6 and the department is in column D
a = Worksheets("Sheet1").Cells(Rows.Count, 5).End(xlUp).Row
For i = 6 To a
If Worksheets("Sheet1").Cells(i, 4).Value >= 3831# And
Worksheets("Sheet1").Cells(i, 4).Value < 3844# Then
Worksheets("Sheet1").Rows(i).Cut
Worksheets("Sheet1").Cells(a + 1, 1).Select
ActiveSheet.Paste
Worksheets("Sheet1").Rows(i).Delete
[enter image description here][1]
End If
Worksheets("Sheet1").Cells(i, 4) = 3844#
Next
Application.CutCopyMode = False
After playing around with SJR's answer, I've come up with this code. The problem is that all the cells at the bottom are cut and pasted in reverse order, so it's now largest to smallest instead of smallest to largest.
a = Worksheets("Sheet1").Cells(Rows.Count, 4).End(xlUp).Row
With Worksheets("Sheet1")
a = .Cells(Rows.Count, 4).End(xlUp).Row
For i = a To 6 Step -1
If .Cells(i, 4).Value < 3831# Or .Cells(i, 4).Value >= 3844# Then
.Rows(i).Cut .Cells(a + 2, 1)
.Rows(i).Delete
End If
Next
End With
You could try this, but I still can't quite get my head round what you are trying to do.
Sub x()
With Worksheets("Sheet1")
a = .Cells(Rows.Count, 5).End(xlUp).Row
For i = a To 6 Step -1
If .Cells(i, 4).Value >= 3831# And .Cells(i, 4).Value < 3844# Then
.Rows(i).Cut .Cells(a + 1, 1)
.Rows(i).Delete
.Cells(i, 4) = 3844#
End If
Next
End With
End Sub