Insert Row if the Entire Row Cell has Zero

[unknownymous]

Hi Guys,

How can I insert a blank row if the entire row has zero ?

Before:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Name[/TD]
[TD]Track1[/TD]
[TD]Track2[/TD]
[TD]Track3[/TD]
[TD]Track4[/TD]
[/TR]
[TR]
[TD]Ben[/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]Sam[/TD]
[TD]3[/TD]
[TD]4[/TD]
[TD]5[/TD]
[TD]6[/TD]
[/TR]
[TR]
[TD]Anna[/TD]
[TD]1[/TD]
[TD]0[/TD]
[TD]5[/TD]
[TD]9[/TD]
[/TR]
[TR]
[TD]Ted[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[/TR]
</tbody>[/TABLE]


After:

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Name[/TD]
[TD]Track1[/TD]
[TD]Track2[/TD]
[TD]Track3[/TD]
[TD]Track4[/TD]
[/TR]
[TR]
[TD]Sam[/TD]
[TD]3[/TD]
[TD]4[/TD]
[TD]5[/TD]
[TD]6[/TD]
[/TR]
[TR]
[TD]Ben[/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]Anna[/TD]
[TD]1[/TD]
[TD]0[/TD]
[TD]5[/TD]
[TD]9[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]ZEROES[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Ted[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[TD]0[/TD]
[/TR]
</tbody>[/TABLE]


Thanks in advance for the help.

 

[unknownymous]

Hi Guys,

This is helpful. By the way, the codes won't work if there's a blank columns in between the Tracks. Also, what if the column header starts on A4. Can you possibly modify the codes? Thank you very much again for the assistance.

 

[Rick Rothstein]

This is helpful. By the way, the codes won't work if there's a blank columns in between the Tracks.

Do you mean one of the tracks is all blanks or do you mean there is a blank column between two of the tracks?

If the latter, then is there a blank column between each track?

 

[unknownymous]

"There is a blank column in between two of the tracks" - this is right and the additional column doesn't have any data or just blank. The Column Header (Name, Track 1, Track2, etc....) starts in A4 as well.

 

[Peter_SSs]

Try this variation

Sub insertRows_v2()
  Dim a As Variant, aRws As Variant, aCols As Variant
  Dim i As Long
  Dim sTest As String
  
  Const hr As Long = 4   '<- Header row
 
  Application.ScreenUpdating = False
  aRws = Evaluate("row(" & hr + 1 & ":" & Range("A" & Rows.Count).End(xlUp).Row & ")")
  aCols = Filter(Evaluate(Replace("if(len(#),column(#),""x"")", "#", Range("B" & hr, Cells(hr, Columns.Count).End(xlToLeft)).Address)), "x", False)
  a = Application.Index(Cells, aRws, aCols)
  sTest = Mid(Replace(String(UBound(a, 2), "0"), 0, "|0"), 2)
  For i = UBound(a) To 2 Step -1
    If Join(Application.Index(a, i, 0), "|") = sTest Then Rows(i + hr).Insert
  Next i
  Application.ScreenUpdating = True
End Sub

 

[unknownymous]

Unfortunately, it didn't work. I have below sample columns (header starts in A4).


ID | Name | SCORE1 | BLANK COLUMN | BLANK COLUMN 2 | SCORE2 | SCORE 3 | BLANK COLUMN | BLANK COLUMN | SCORE 4 UNTIL 13


Sorry for the confusion and let me know if you need more details

 

[Peter_SSs]

Unfortunately, it didn't work. I have below sample columns (header starts in A4).


ID | Name | SCORE1 | BLANK COLUMN | BLANK COLUMN 2 | SCORE2 | SCORE 3 | BLANK COLUMN | BLANK COLUMN | SCORE 4 UNTIL 13

That is because you have changed your data structure.

In post #1 you had col A only as a text column followed by numerical columns. Then you said you had blank columns among the 'Track' columns so the code was adjusted for that.
Now you have column B as a text column as well.

As the code was checking for all "0"s from the second column on, that is unlikely to happen if column B contains names.

Try making this one-letter change

aCols = Filter(Evaluate(Replace("if(len(#),column(#),""x"")", "#", Range("C" & hr, Cells(hr, Columns.Count).End(xlToLeft)).Address)), "x", False)

 

[Rick Rothstein]

Unfortunately, it didn't work. I have below sample columns (header starts in A4).

ID | Name | SCORE1 | BLANK COLUMN | BLANK COLUMN 2 | SCORE2 | SCORE 3 | BLANK COLUMN | BLANK COLUMN | SCORE 4 UNTIL 13

Sorry for the confusion and let me know if you need more details

As Peter said, you changed your layout from what you originally told us you had, so you should not expect the code we developed for your originally posted layout to work for the "new" layout you are just telling us about.

I would probably go with the code Peter posted as it is less cumbersome looking than mine (and probably faster, although I did not test for that), but for completeness sake, here is the code I posted in Message #10 modified for your above layout (where I am assuming there are always 2 blank columns between ever two non-blank columns after Score1's column...

[table="width: 500"]
[tr]
	[td]Sub InsertRowsAboveAllZeroes()
  Dim R As Long, HeaderRow As Long, LastRow As Long, LastCol As Long, Arr As Variant
  HeaderRow = 4
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  LastCol = Cells(HeaderRow, Columns.Count).End(xlToLeft).Column
  Arr = Split(Application.Trim(Join(Application.Transpose(Evaluate("IF(COUNTIF(OFFSET(C" & HeaderRow + 1 & ",ROW(A1:A" & LastRow - HeaderRow & ")-1,0,1," & LastCol - 2 & "),0)=" & (LastCol - 1) / 2 & "," & HeaderRow & "+Row(A1:A" & LastRow - HeaderRow & "),"""")")))))
  Application.ScreenUpdating = False
  For R = UBound(Arr) To 0 Step -1
    If Len(Arr(R)) Then Rows(Arr(R)).Insert
  Next
  Application.ScreenUpdating = True
End Sub[/td]
[/tr]
[/table]

 

[unknownymous]

Thanks a lot for this Peter! Really appreciate it. One thing, what if the range that needs to check is until columns T as there are text words indicated in Col U onwards? Thanks again!

 

[Peter_SSs]

Thanks a lot for this Peter! Really appreciate it. One thing, what if the range that needs to check is until columns T as there are text words indicated in Col U onwards? Thanks again!

1. I'm not sure that I fully understand. Can you clarify further?

2. Are there any further modifications to come? It would be best to have the full picture to develop the best solution straight off, rather gradually adapt the first solution to a less-than-satisfactory final outcome.

 

[unknownymous]

Alright...see below headers (BTW I put Score1 after the blank column

ID | Name | BLANK COL1 | BLANK COL2 | SCORE1 | SCORE2 | BLANK COL3 | BLANK COL4 | SCORE3 UNTIL 14| NOTE1 UNTIL 11

Whereas: Column SCORE3 UNTIL 12 is in range I4:T4 ; Column NOTE1 UNTIL 11range is U4:AE4