Results 1 to 10 of 10
Thread: Move row based on total (2007)

20071016, 04:14 #1
 Join Date
 Jan 2001
 Location
 La Jolla, CA
 Posts
 1,536
 Thanks
 38
 Thanked 68 Times in 64 Posts
Move row based on total (2007)
Probably VB which I don't know...
Spreadsheet has row 1 with headings.
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.
Thanks, in advance.

20071016, 04:44 #2
 Join Date
 Aug 2004
 Location
 Connecticut, USA
 Posts
 816
 Thanks
 0
 Thanked 0 Times in 0 Posts
Re: Move row based on total (2007)
Can you post an example spreadsheet?

20071016, 05:01 #3
 Join Date
 Jan 2001
 Location
 La Jolla, CA
 Posts
 1,536
 Thanks
 38
 Thanked 68 Times in 64 Posts
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)

20071016, 05:32 #4
 Join Date
 Aug 2004
 Location
 Connecticut, USA
 Posts
 816
 Thanks
 0
 Thanked 0 Times in 0 Posts
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)
delete your dummy column

20071016, 10:29 #5
 Join Date
 Jan 2001
 Location
 La Jolla, CA
 Posts
 1,536
 Thanks
 38
 Thanked 68 Times in 64 Posts
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.

20071016, 10:35 #6
 Join Date
 Jan 2001
 Location
 La Jolla, CA
 Posts
 1,536
 Thanks
 38
 Thanked 68 Times in 64 Posts
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.

20071016, 14:36 #7
 Join Date
 Jul 2002
 Location
 Pittsburgh, Pennsylvania, USA
 Posts
 11,225
 Thanks
 14
 Thanked 342 Times in 335 Posts
Re: Move row based on total (2007)
How about this?
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>

20071016, 14:40 #8
 Join Date
 Mar 2002
 Posts
 84,353
 Thanks
 0
 Thanked 30 Times in 30 Posts
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

20071016, 14:59 #9
 Join Date
 Jan 2001
 Location
 La Jolla, CA
 Posts
 1,536
 Thanks
 38
 Thanked 68 Times in 64 Posts
Re: Move row based on total (2007)
Thank you, Hans...works as requested, of course.
Kevin

20071016, 14:59 #10
 Join Date
 Aug 2004
 Location
 Connecticut, USA
 Posts
 816
 Thanks
 0
 Thanked 0 Times in 0 Posts
Re: Move row based on total (2007)
I forgot about that part.
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
Application.DisplayAlerts = False
Range(Cells(2, 1), Cells(rCount, 1)).Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
Application.DisplayAlerts = True
handler:
Range("a1").Select
End Sub
</pre>