# Thread: Move row based on total (2007)

1. ## Move row based on total (2007)

Probably VB which I don't know...

Column A is names
Column B, C, etc. contain hours (integers).

I need a macro (VB, I assume) that will do the following.

When the total of any given row (cols B through whatever) is greater than or equal to 12,
move this row to the bottom of the name list and blank out the numbers in the cell from col B on. The name in col A must remain.

2. ## Re: Move row based on total (2007)

Can you post an example spreadsheet?

3. ## Re: Move row based on total (2007)

See the attachment. Thanks!!
(this is not in 2007, but I assume the VB won't be any different)

4. ## Re: Move row based on total (2007)

Here's a macro free method.

Insert a dummy column in front of your data (it will be you new column A)
label it - doesn't matter what - so the table will sort correctly.
enter the following formula in A2:
=IF(SUM(C2:Z2)>=12,"ZZZ"&B2,B2)
copy the formula down the column as far as necessary
sort the table on column A (ascending)

5. ## Re: Move row based on total (2007)

Interesting solution, but I'd really like a macro to run so that the data is just "fixed"...I guess I could turn this into a macro, insert the col, do the sort, and then delete the col. Thought there might be another, more direct solution using VB.

6. ## Re: Move row based on total (2007)

Also, in your solution, after sorting, the user would then have to go into the specific rows and delete the data...which I was hoping could be done automatically with a macro.

7. ## Re: Move row based on total (2007)

Steve

<pre>Option Explicit
Sub FixData()
Dim iCol As Integer
Dim lRow As Long
Dim i As Long
Dim x As Long
Dim AWF As WorksheetFunction
Dim rDelete As Range
Set AWF = Application.WorksheetFunction
iCol = Range("IV1").End(xlToLeft).Column
lRow = Range("A65536").End(xlUp).Row
i = lRow + 1
For x = 2 To lRow
If AWF.Sum(Range(Cells(x, 2), Cells(x, iCol))) >= 12 Then
Cells(i, 1) = Cells(x, 1)
i = i + 1
If rDelete Is Nothing Then
Set rDelete = Rows(x)
Else
Set rDelete = Union(rDelete, Rows(x))
End If
End If
Next
If Not rDelete Is Nothing Then rDelete.Delete
Set AWF = Nothing
Set rDelete = Nothing
End Sub</pre>

8. ## Re: Move row based on total (2007)

Try this:

Sub FixEm()
Dim r As Long
Dim n As Long
Dim t As Long
Dim s As Double

Application.ScreenUpdating = False

n = Cells(Rows.Count, 1).End(xlUp).Row
t = n

' Move name if necessary
For r = 2 To n
s = Application.Sum(Range(Cells(r, 2), Cells(r, Columns.Count)))
If s >= 12 Then
t = t + 1
Cells(r, 1).Cut Destination:=Cells(t, 1)
End If
Next r

' Delete blanks
For r = n To 2 Step -1
If Cells(r, 1) = "" Then
Rows®.Delete
End If
Next r

Application.ScreenUpdating = True
End Sub

9. ## Re: Move row based on total (2007)

Thank you, Hans...works as requested, of course.

Kevin

10. ## Re: Move row based on total (2007)

Try this one:
Option Explicit
<pre>Sub shift()
Dim rCount As Long, rDest As Long, rLoop As Long

rCount = Cells(65536, 1).End(xlUp).Row

rDest = rCount + 1
For rLoop = 2 To rCount

If Application.WorksheetFunction.Sum(Range(Cells(rLoo p, 2), Cells(rLoop, 100))) >= 12 Then
Cells(rDest, 1) = Cells(rLoop, 1)
Range(Cells(rLoop, 1), Cells(rLoop, 100)).ClearContents
rDest = rDest + 1

End If
Next

On Error GoTo handler
Range(Cells(2, 1), Cells(rCount, 1)).Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete

handler:
Range("a1").Select

End Sub
</pre>

#### Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•