VBA: Separate & Add Row if All Column Has Zero

[unknownymous]

Hi Guys,

I'm trying to create a macro where cell that has "0" value will be separated.

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Code[/TD]
[TD]Name[/TD]
[TD]Score 1[/TD]
[TD]Score 2[/TD]
[TD]Score 3[/TD]
[TD]Score 4[/TD]
[TD]Score 5[/TD]
[TD]Score 6[/TD]
[/TR]
[TR]
[TD]01[/TD]
[TD]John[/TD]
[TD]98[/TD]
[TD]98[/TD]
[TD]95[/TD]
[TD]95[/TD]
[TD]93[/TD]
[TD]90[/TD]
[/TR]
[TR]
[TD]02[/TD]
[TD]Ben[/TD]
[TD]96[/TD]
[TD]97[/TD]
[TD]94[/TD]
[TD]93[/TD]
[TD]93[/TD]
[TD]90[/TD]
[/TR]
[TR]
[TD]03[/TD]
[TD]Sean[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD]04[/TD]
[TD]Carl[/TD]
[TD]90[/TD]
[TD]0[/TD]
[TD]90[/TD]
[TD]0[/TD]
[TD]89[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD]05[/TD]
[TD]Tim[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[/TR]
</tbody>[/TABLE]

End result:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Code[/TD]
[TD]Name[/TD]
[TD]Score 1[/TD]
[TD]Score 2[/TD]
[TD]Score 3[/TD]
[TD]Score 4[/TD]
[TD]Score 5[/TD]
[TD]Score 6[/TD]
[/TR]
[TR]
[TD]01[/TD]
[TD]John[/TD]
[TD]98[/TD]
[TD]98[/TD]
[TD]95[/TD]
[TD]95[/TD]
[TD]93[/TD]
[TD]90[/TD]
[/TR]
[TR]
[TD]02[/TD]
[TD]Ben[/TD]
[TD]96[/TD]
[TD]97[/TD]
[TD]94[/TD]
[TD]93[/TD]
[TD]93[/TD]
[TD]90[/TD]
[/TR]
[TR]
[TD]04[/TD]
[TD]Carl[/TD]
[TD]90[/TD]
[TD]0[/TD]
[TD]90[/TD]
[TD]0[/TD]
[TD]89[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]03[/TD]
[TD]Sean[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD]05[/TD]
[TD]Tim[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[/TR]
</tbody>[/TABLE]



Any help will be much appreciated.

Thank you!

 

[Rick Rothstein]

Give this macro a try...

[table="width: 500"]
[tr]
	[td]Sub MoveZeroRows()
  Dim LastRow As Long, LastCol As Long
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
  Application.ScreenUpdating = False
  With Range(Cells(2, LastCol + 1), Cells(LastRow, LastCol + 1))
    .Formula = "=IF(SUM(C2:" & Cells(2, LastCol).Address(0, 0) & ")=0,99999,ROW(C2))"
    .Value = .Value
    .Offset(, -LastCol).Resize(, LastCol + 1).Sort Cells(1, LastCol + 1), xlAscending
  End With
  On Error Resume Next
  Columns(LastCol + 1).Find(99999, , xlValues, xlWhole, , xlNext, , , False).EntireRow.Insert
  On Error GoTo 0
  Columns(LastCol + 1).Delete
  Application.ScreenUpdating = True
End Sub[/td]
[/tr]
[/table]

 

[unknownymous]

It works! Thank you

 

[unknownymous]

Hi Rick,

I noticed that whenever I add 2 blank columns in between Score 1 & Score 2, column Score 1 column with data is separated together with the zeroes. How can we modify this? Thank you.

 

[Rick Rothstein]

I noticed that whenever I add 2 blank columns in between Score 1 & Score 2, column Score 1 column with data is separated together with the zeroes. How can we modify this? Thank you.

I am not sure what you are asking for here... when I do what you describe, the results look like I would expect them to. Can you describe the problem you are seeing in more detail (perhaps post tables like you did in Message #1 )?

 

[unknownymous]

Yup, indeed working! Thank you