ClearContents of the row if finds all 1's in it.

[Kishan]

Hi,</SPAN></SPAN>

Sheet1 show the data in the columns C:P are filled with 1's in it. But the row 6, 7, 8, 9 has in it X or 2 filled, is it possible ClearContents (do not eliminate the rows) of the row in which has only 1's in it (for example row 10 to 22 row) </SPAN></SPAN>

Note: filled row would be in order up to down there will not be any row in middle filled with X's or 2's</SPAN></SPAN>

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R
1
2
3
4
5			P1	P2	P3	P4	P5	P6	P7	P8	P9	P10	P11	P12	P13	P14
6			1	1	1	1	1	X	1	1	1	1	1	1	1	1
7			2	1	1	1	1	1	1	1	1	1	1	1	1	1
8			1	X	1	1	1	1	1	1	2	1	1	1	1	1
9			1	1	1	X	X	X	1	2	1	1	1	1	1	1
10			1	1	1	1	1	1	1	1	1	1	1	1	1	1
11			1	1	1	1	1	1	1	1	1	1	1	1	1	1
12			1	1	1	1	1	1	1	1	1	1	1	1	1	1
13			1	1	1	1	1	1	1	1	1	1	1	1	1	1
14			1	1	1	1	1	1	1	1	1	1	1	1	1	1
15			1	1	1	1	1	1	1	1	1	1	1	1	1	1
16			1	1	1	1	1	1	1	1	1	1	1	1	1	1
17			1	1	1	1	1	1	1	1	1	1	1	1	1	1
18			1	1	1	1	1	1	1	1	1	1	1	1	1	1
19			1	1	1	1	1	1	1	1	1	1	1	1	1	1
20			1	1	1	1	1	1	1	1	1	1	1	1	1	1
21			1	1	1	1	1	1	1	1	1	1	1	1	1	1
22			1	1	1	1	1	1	1	1	1	1	1	1	1	1
23
24
25
Sheet1

And after macro get the result as shown below only rows filled with mixed 1, X, 2</SPAN></SPAN>

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R
1
2
3
4
5			P1	P2	P3	P4	P5	P6	P7	P8	P9	P10	P11	P12	P13	P14
6			1	1	1	1	1	X	1	1	1	1	1	1	1	1
7			2	1	1	1	1	1	1	1	1	1	1	1	1	1
8			1	X	1	1	1	1	1	1	2	1	1	1	1	1
9			1	1	1	X	X	X	1	2	1	1	1	1	1	1
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Sheet1-Result

Thank you in advance</SPAN></SPAN>

Using Excel 2000</SPAN></SPAN>

Regards,</SPAN></SPAN>
Kishan</SPAN>

 

[Fluff]

If I understand correctly, once you find a row that is only 1s you want to clear that row & all rows below.

Sub Kishan()
   Dim Cl As Range
   Dim UsdRws As Long
   
   UsdRws = Range("C" & Rows.Count).End(xlUp).Row
   For Each Cl In Range("C6:C" & UsdRws)
      If Application.CountIf(Cl.Resize(, 14), 1) = 14 Then
         Cl.Resize(UsdRws - Cl.Row + 1, 14).Clear
         Exit For
      End If
   Next Cl
End Sub

 

[Joe4]

Try this:

Sub ClearRows()

    Dim lr As Long, r As Long
    Dim rng As Range
    
    Application.ScreenUpdating = False
    
'   Find last row in column C with data
    lr = Cells(Rows.Count, "C").End(xlUp).Row
    
'   Loop through all rows starting in row 6
    For r = 6 To lr
'       Check to see if equal to 1 in all columns
        Set rng = Range(Cells(r, "C"), Cells(r, "P"))
        If Application.WorksheetFunction.CountIf(rng, 1) = 14 Then
'           Clear range
            rng.ClearContents
        End If
    Next r
    
    Application.ScreenUpdating = True
    
End Sub

 

[Kishan]

If I understand correctly, once you find a row that is only 1s you want to clear that row & all rows below.

Sub Kishan()
   Dim Cl As Range
   Dim UsdRws As Long
   
   UsdRws = Range("C" & Rows.Count).End(xlUp).Row
   For Each Cl In Range("C6:C" & UsdRws)
      If Application.CountIf(Cl.Resize(, 14), 1) = 14 Then
         Cl.Resize(UsdRws - Cl.Row + 1, 14).Clear
         Exit For
      End If
   Next Cl
End Sub

Fluff, it worked perfect as I request I did changed .Clear to .ClearContents so not to delete the format.</SPAN></SPAN>

Thank you for your help</SPAN></SPAN>

Kind Regards,</SPAN></SPAN>
Kishan </SPAN></SPAN>

 

[Kishan]

Try this:

Sub ClearRows()

    Dim lr As Long, r As Long
    Dim rng As Range
    
    Application.ScreenUpdating = False
    
'   Find last row in column C with data
    lr = Cells(Rows.Count, "C").End(xlUp).Row
    
'   Loop through all rows starting in row 6
    For r = 6 To lr
'       Check to see if equal to 1 in all columns
        Set rng = Range(Cells(r, "C"), Cells(r, "P"))
        If Application.WorksheetFunction.CountIf(rng, 1) = 14 Then
'           Clear range
            rng.ClearContents
        End If
    Next r
    
    Application.ScreenUpdating = True
    
End Sub

Joe4, I liked your solution too. Which lives all rows that contains X and 2 and ClearContents rest rows that is only 1's </SPAN></SPAN>

Thank you for your help</SPAN></SPAN>

Kind Regards,</SPAN></SPAN>
Kishan </SPAN></SPAN>

 

[Fluff]

Glad we could help& thanks for the feedback