Excel vba удалить строку если ячейка пустая

Can anyone walk me through how to write a script to delete the entire row if a cell in column D = «» on sheet 3 in range D13:D40.

Also, how to prevent the user from accidentally running the script again once those cells in the range are already deleted and other cells are now on the D13:D40 range?

No need for loops:

Sub SO()

Static alreadyRan As Integer

restart:

If Not CBool(alreadyRan) Then
    With Sheets("Sheet3")
        With .Range("D13:D40")
            .AutoFilter 1, "="
            With .SpecialCells(xlCellTypeVisible)
                If .Areas.Count > 1 Then
                    .EntireRow.Delete
                    alreadyRan = alreadyRan + 1
                End If
            End With
        End With
        .AutoFilterMode = False
    End With
Else
    If MsgBox("procedure has already been run, do you wish to continue anyway?", vbYesNo) = vbYes Then
        alreadyRan = 0
        GoTo restart:
    End If
End If

End Sub

Use AutoFilter to find blank cells, and then use SpecialCells to remove the results. Uses a Static variable to keep track of when the procedure has been run.

answered Jul 3, 2015 at 13:04

Here’s my take on it. See the comments in the code for what happens along the way.

Sub deleterow()
  ' First declare the variables you are going to use in the sub
  Dim i As Long, safety_net As Long
  ' Loop through the row-numbers you want to change.
  For i = 13 To 40 Step 1
    ' While the value in the cell we are currently examining = "", we delete the row we are on
    ' To avoid an infinite loop, we add a "safety-net", to ensure that we never loop more than 100 times
    While Worksheets("Sheet3").Range("D" & CStr(i)).Value = "" And safety_net < 100
      ' Delete the row of the current cell we are examining
      Worksheets("Sheet3").Range("D" & CStr(i)).EntireRow.Delete
      ' Increase the loop-counter
      safety_net = safety_net + 1
    Wend
    ' Reset the loop-counter
    safety_net = 0
  ' Move back to the top of the loop, incrementing i by the value specified in step. Default value is 1.
  Next i
End Sub

To prevent a user from running the code by accident, I’d probably just add Option Private Module at the top of the module, and password-protect the VBA-project, but then again it’s not that easy to run it by accident in the first place.

answered Jul 3, 2015 at 12:10

This code executes via a button on the sheet that, once run, removes the button from the worksheet so it cannot be run again.

Sub DeleteBlanks()
    Dim rw As Integer, buttonID As String

    buttonID = Application.Caller

    For rw = 40 To 13 Step -1

        If Range("D" & rw) = "" Then
            Range("D" & rw).EntireRow.Delete
        End If

    Next rw

    ActiveSheet.Buttons(buttonID).Delete
End Sub

You’ll need to add a button to your spreadsheet and assign the macro to it.

answered Jul 4, 2015 at 9:11

I would like to delete the empty rows my ERP Quotation generates. I’m trying to go through the document (A1:Z50) and for each row where there is no data in the cells (A1-B1...Z1 = empty, A5-B5...Z5 = empty) I want to delete them.

I found this, but can’t seem to configure it for me.

On Error Resume Next
Worksheet.Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0

for those who are intersted to remove «empty» and «blank» rows ( Ctrl + Shift + End going deep down of your worksheet ) .. here is my code.
It will find the last «real»row in each sheet and delete the remaining blank rows.

Function XLBlank()
    For Each sh In ActiveWorkbook.Worksheets
        sh.Activate
        Cells(1, 1).Select
        lRow = Cells.Find(What:="*", _
            After:=Range("A1"), _
            LookAt:=xlPart, _
            LookIn:=xlFormulas, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious, _
            MatchCase:=False).Row
        
        Range("A" & lRow + 1, Range("A1").SpecialCells(xlCellTypeLastCell).Address).Select
        On Error Resume Next
        Selection.EntireRow.SpecialCells(xlBlanks).EntireRow.Delete
        Cells(1, 1).Select
    Next
    ActiveWorkbook.Save
    ActiveWorkbook.Worksheets(1).Activate
End Function

Open VBA ( ALT + F11 ), Insert -> Module,
Copy past my code and launch it with F5.
Et voila

To make Alex K’s answer slightly more dynamic you could use the code below:

Sub DeleteBlankRows()

Dim wks As Worksheet
Dim lngLastRow As Long, lngLastCol As Long, lngIdx As Long, _
    lngColCounter As Long
Dim blnAllBlank As Boolean
Dim UserInputSheet As String

UserInputSheet = Application.InputBox("Enter the name of the sheet which you wish to remove empty rows from")

Set wks = Worksheets(UserInputSheet)

With wks
    'Now that our sheet is defined, we'll find the last row and last column
    lngLastRow = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                             SearchOrder:=xlByRows, _
                             SearchDirection:=xlPrevious).Row
    lngLastCol = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                             SearchOrder:=xlByColumns, _
                             SearchDirection:=xlPrevious).Column

    'Since we need to delete rows, we start from the bottom and move up
    For lngIdx = lngLastRow To 1 Step -1

        'Start by setting a flag to immediately stop checking
        'if a cell is NOT blank and initializing the column counter
        blnAllBlank = True
        lngColCounter = 2

        'Check cells from left to right while the flag is True
        'and the we are within the farthest-right column
        While blnAllBlank And lngColCounter <= lngLastCol

            'If the cell is NOT blank, trip the flag and exit the loop
            If .Cells(lngIdx, lngColCounter) <> "" Then
                blnAllBlank = False
            Else
                lngColCounter = lngColCounter + 1
            End If

        Wend

        'Delete the row if the blnBlank variable is True
        If blnAllBlank Then
            .rows(lngIdx).delete
        End If

    Next lngIdx
End With


MsgBox "Blank rows have been deleted."

 End Sub

This was sourced from this website and then slightly adapted to allow the user to choose which worksheet they want to empty rows removed from.

answered Dec 18, 2017 at 21:50

In order to have the On Error Resume function work you must declare the workbook and worksheet values as such

On Error Resume Next  
ActiveWorkbook.Worksheets("Sheet Name").Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete  
On Error GoTo 0

I had the same issue and this eliminated all the empty rows without the need to implement a For loop.

answered Apr 30, 2018 at 14:39

This worked great for me (you can adjust lastrow and lastcol as needed):

Sub delete_rows_blank2()

t = 1
lastrow = ActiveSheet.UsedRange.Rows.Count
lastcol = ActiveSheet.UsedRange.Columns.Count

Do Until t = lastrow

For j = 1 To lastcol
    'This only checks the first column because the "Else" statement below will skip to the next row if the first column has content.
    If Cells(t, j) = "" Then

        j = j + 1

            If j = lastcol Then
            Rows(t).Delete
            t = t + 1
            End If

    Else
    'Note that doing this row skip, may prevent user from checking other columns for blanks.
        t = t + 1

    End If

Next

Loop

End Sub

Here is the quickest way to Delete all blank Rows ( based on one Columns )

Dim lstRow as integet, ws as worksheet

Set ws = ThisWorkbook.Sheets("NameOfSheet")

With ws

     lstRow = .Cells(Rows.Count, "B").End(xlUp).Row ' Or Rows.Count "B", "C" or "A" depends 

     .Range("A1:E" & lstRow).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End with

answered Mar 10, 2022 at 15:46

Here is a piece of code I use for that type of operation.

Sub ClearBlank()

Dim i As Long

For i = Range(«B65536»).End(xlUp).Row To 8 Step -1
If IsEmpty(Cells(i, 4)) Then Rows(i).Delete

Next i

End Sub

I hope this helps!

answered Dec 6, 2012 at 19:23

Not used VBA before today so I’m sure there is a neater way…but this code will delete any row with at least one empty cell. It assumes that you have a header row and that the first column is used for IDs so these cells are not ‘looked at’.

The nice thing about this script is that it works for any size of spreadsheet so you don’t need to hard-code values each time:

Sub DeleteIncompleteRows()
Dim row As Integer, col As Integer
Dim deleted As Integer
deleted = 0
Dim actualRow As Integer
Dim totalRows As Integer
Dim totalCols As Integer
totalRows = Application.CountA(Range("A:A"))
totalCols = Application.CountA(Range("1:1"))

For row = 2 To totalRows
actualRow = row - deleted
For col = 2 To totalCols
If ActiveSheet.Cells(actualRow, col).Value = "" Then
ActiveSheet.Rows(actualRow).Delete
deleted = deleted + 1
Exit For
End If
Next col
Next row
End Sub

All the best,

Scott

answered Jan 17, 2013 at 21:39