Deleting Entire Row if a Cell Located in Column A contains "1"

[eagerbeav3r]

Hey everyone,

I searched for a solution on this but I didnt find anything that works for me.
The Commandbutton for this is located in Sheet 1 and i want the VBA Code to delete every row that contains "1" in Sheet 3,

If ActiveSheet.CheckBox1 = False Then

'This is where I need the Code to work

 

[My Aswer Is This]

You said:
i want the VBA Code to delete every row that contains "1" in Sheet 3,

Where are we to look? Excel has 1.5 million rows, and 16,384 columns so must we look in all of about 5 billion cells for the number 1

 

[eagerbeav3r]

You said:
i want the VBA Code to delete every row that contains "1" in Sheet 3,

Where are we to look? Excel has 1.5 million rows, and 16,384 columns so must we look in all of about 5 billion cells for the number 1

As I said above. I want it to delete all cells containing "1" (or other specific text) in Collumn A...

 

[Peter_SSs]

cells containing "1"

By your definition of "containing" do both of the cells below contain "1", or only cell A2"

22 06 21.xlsm
	A
1	X1Y
2	1
1

 

[eagerbeav3r]

By your definition of "containing" do both of the cells below contain "1", or only cell A2"

22 06 21.xlsm
	A
1	X1Y
2	1
1

Only Cell A2

 

[johnnyL]

How about:

Sub Test1()
'
    Dim ArrayRow        As Long, LastRow    As Long
    Dim rng             As Range
    Dim SearchString    As String
    Dim InputArray      As Variant
    Dim ws              As Worksheet
'
    SearchString = "1"                                                                  ' <--- Set this to the string to search for
    Set ws = Sheets("Sheet3")                                                           ' <--- Set this to the sheet name to be checked
'
    LastRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
'
    Set rng = ws.Range("A" & LastRow + 1)
'
    InputArray = ws.Range("A1:A" & LastRow).Value
'
    For ArrayRow = 1 To UBound(InputArray)
        If InputArray(ArrayRow, 1) = SearchString Then Set rng = Union(rng, ws.Range("A" & ArrayRow))
    Next
'
    rng.EntireRow.Delete
End Sub

 

[Peter_SSs]

I have assumed a heading row in row 1
If there is not a large number of disjoint rows to be deleted then this should suffice ..

Sub Del_1_v1()
  With Range("A1", Range("A" & Rows.Count).End(xlUp))
    .AutoFilter Field:=1, Criteria1:=1
    .Offset(1).EntireRow.Delete
    .AutoFilter Field:=1
  End With
End Sub

If there is a large number of disjoint rows to be deleted then this would be much faster ..

Sub Del_1_v2()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long
 
  nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  a = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    If a(i, 1) = 1 Then
      b(i, 1) = 1
      k = k + 1
    End If
  Next i
  If k > 0 Then
    Application.ScreenUpdating = False
    With Range("A2").Resize(UBound(a), nc)
      .Columns(nc).Value = b
      .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
      .Resize(k).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
  End If
End Sub

 

[Rick Rothstein]

Here is another macro that you can try...

Sub DeleteColumnARowsWith1()
  Application.ScreenUpdating = False
  Columns("A").Replace 1, "#N/A", xlWhole
  Columns("A").SpecialCells(xlConstants, xlErrors).EntireRow.Delete
  Application.ScreenUpdating = True
End Sub

 

[Peter_SSs]

Just realised that I forgot the code was for a specific sheet. My codes should have been

Sub Del_1_v1()
  With Sheets("Sheet 3").Range("A1", Sheets("Sheet 3").Range("A" & Rows.Count).End(xlUp))
    .AutoFilter Field:=1, Criteria1:=1
    .Offset(1).EntireRow.Delete
    .AutoFilter Field:=1
  End With
End Sub

Sub Del_1_v2()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long
  
  With Sheets("Sheet 3")
    nc = .Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    a = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Value
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
      If a(i, 1) = 1 Then
        b(i, 1) = 1
        k = k + 1
      End If
    Next i
    If k > 0 Then
      Application.ScreenUpdating = False
      With .Range("A2").Resize(UBound(a), nc)
        .Columns(nc).Value = b
        .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
        .Resize(k).EntireRow.Delete
      End With
      Application.ScreenUpdating = True
    End If
  End With
End Sub

Here is another macro that you can try...

We do not know the OP's exact circumstances but that may need a little more in case there are no "1" cells.
Presumably unlikely, but also might be possible that column A already has #N/A constants?

 

[Rick Rothstein]

We do not know the OP's exact circumstances but that may need a little more in case there are no "1" cells.
Presumably unlikely, but also might be possible that column A already has #N/A constants?

I would think it rare for someone to use #N/A as a constant value (would look too much like the #N/A error generated by formulas) as opposed to the standard N/A designation for not applicable. Still, I guess it is possible, but as you said, we don't know the OP's exact circumstance, so I guessed. As for the no 1's situation... yes, you are correct that I should have accounted for it...

Sub DeleteColumnARowsWith1()
  On Error GoTo NoOnes
  Application.ScreenUpdating = False
  Columns("A").Replace 1, "#N/A", xlWhole
  Columns("A").SpecialCells(xlConstants, xlErrors).EntireRow.Delete
NoOnes:
  Application.ScreenUpdating = True
End Sub