CODEWITHSUNDEEP
excelvba
Alex
Alex

Reputation: 170

How can I update code to delete blanks to also delete a specific "string"?

How can I update code to delete the row if the cell in column A is Blank, to as well delete the row if the cell in column A contains the string "Gender"?

I assume I need to update: Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete 

Application.ScreenUpdating = False
For Each ws In Worksheets 'and here
    Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

    For Each MyCell In ws.Range("A2:EA2")
        If Not IsInArray(MyCell, arr) Then
            If HideMe Is Nothing Then
                Set HideMe = MyCell
            Else
                Set HideMe = Union(HideMe, MyCell)
            End If
        End If
    Next MyCell

    If Not HideMe Is Nothing Then
        HideMe.EntireColumn.Hidden = True
    End If

    Set HideMe = Nothing 'and here
Next ws 'and here
Application.ScreenUpdating = True

Upvotes: 0

Views: 76

Answers (2)

JvdV
JvdV

Reputation: 75900

Hereby the options to deal with this loop:

1). First option is to delete row by row when criteria is met:

Option Explicit
Private Sub remove_blank_or_gender()

Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer

Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
    Dim lr As Long 'last row
    lr = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    Dim i As Long
    For i = lr To 1 Step -1
        If IsEmpty(ws.Cells(i, 1)) Or ws.Cells(i, 1) = "Gender" Then
            ws.Rows(i).EntireRow.Delete
        End If
    Next i
Next ws

SecondsElapsed = Round(Timer - StartTime, 2)
Debug.Print SecondsElapsed

End Sub

Executing this code on a workbook with one worksheet with column A, rows 1-1000 all filled with the value 'Gender', will result in a runtime of:

enter image description here

2). Option two using Union function:

Option Explicit
Private Sub remove_blank_or_gender()

Dim StartTime As Double
Dim SecondsElapsed As Double
Dim RNG As Range
StartTime = Timer

Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
    Set RNG = Nothing
    Dim lr As Long 'last row
    lr = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    Dim i As Long
    For i = lr To 1 Step -1
        If IsEmpty(ws.Cells(i, 1)) Or ws.Cells(i, 1) = "Gender" Then
            If Not RNG Is Nothing Then
                Set RNG = Union(RNG, Range(ws.Cells(i, 1).Address))
            Else
                Set RNG = Range(ws.Cells(i, 1).Address)
            End If
        End If
    Next i
RNG.Rows.EntireRow.Delete
Next ws

SecondsElapsed = Round(Timer - StartTime, 2)
Debug.Print SecondsElapsed

End Sub

This results in a runtime of:

enter image description here

The code is a bit messy, but my intention was to provide the two options to show the difference in runtime :). Pls note these tests are done locally and times can vary!

Good luck!

Upvotes: 2

Samuel Hulla
Samuel Hulla

Reputation: 7099

it's fairly simple:

  1. Loop through every worksheet
  2. Determine last row (lr) in the current worksheet
  3. Loop through a range of cells in column A
  4. If the condition is met, delete the row

note, this ^ is not the order in which the code executes, but top-to-bottom explanation of code

Option Explicit
Private Sub remove_blank_or_gender()

   Dim ws As Worksheet
   For Each ws In ThisWorkbook.Sheets

       Dim lr As Long 'last row
       lr = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

       Dim i As Long
       For i = lr To 1 Step -1
           If IsEmpty(ws.Cells(i, 1)) Or ws.Cells(i, 1) = "Gender" Then
                ws.Rows(i).EntireRow.Delete
           End If
       Next i

    Next ws

End Sub

If you have any questions, let me know.

Also on a sidenote, please avoid pasting your entire code into your question. The code you post should only contain relevant information to the question as per: Minimal, Complete and Verifiable Example

Upvotes: 2

Related Questions