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

eagerbeav3r

New Member
Joined
Feb 24, 2022
Messages
14
Office Version
  1. 365
Platform
  1. Windows
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,

VBA Code:
If ActiveSheet.CheckBox1 = False Then

'This is where I need the Code to work
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
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
 
Upvote 0
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...
 
Upvote 0
How about:

VBA Code:
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
 
Upvote 0
Solution
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 ..

VBA Code:
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 ..

VBA Code:
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
 
Upvote 0
Here is another macro that you can try...
VBA Code:
Sub DeleteColumnARowsWith1()
  Application.ScreenUpdating = False
  Columns("A").Replace 1, "#N/A", xlWhole
  Columns("A").SpecialCells(xlConstants, xlErrors).EntireRow.Delete
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
Just realised that I forgot the code was for a specific sheet. My codes should have been

VBA Code:
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

VBA Code:
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?
 
Upvote 0
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...
VBA Code:
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
 
Upvote 0

Forum statistics

Threads
1,223,886
Messages
6,175,195
Members
452,616
Latest member
intern444

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top