• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 676
  • Last Modified:

Deleting Blank Rows from Excel

Hi,

I have a number of dynamic tabs in an Excel file and I need help with VBA on each tab which will delete any blank rows.  For example, if there are headers in columns A-G, and a user puts values in any of the cells in each row but skips and entire row of cells, upon closing I want the VBA to delete that blank row.

I've been trying to figure it out but I'm going in circles. Any help would be greatly appreciated.

Thanks!
0
monbois
Asked:
monbois
  • 8
  • 8
  • 5
1 Solution
 
kgerbChief EngineerCommented:
Try this one.  For starters it will just highlight the rows red instead of deleting them.  Once you're sure it's working correctly remove the comment from
'Rw.EntireRow.Delete

Open in new window

and delete this line
Rw.EntireRow.Interior.ColorIndex = 3

Open in new window

Let me know if it works for you.

Kyle

Sub DeleteBlankRows3()
Dim Rw As Range, rng As Range, rngSel As Range
Set rng = Range("A1", Cells(Rows.Count, "G").End(xlUp))
Set rng = rng.SpecialCells(xlCellTypeBlanks)
For Each Rw In rng.Rows
    If WorksheetFunction.CountA(Rw.EntireRow) = 0 Then
        'Rw.EntireRow.Delete
        Rw.EntireRow.Interior.ColorIndex = 3
    End If
Next Rw
End Sub

Open in new window

0
 
Davy2270Commented:
I think Kyle's code will work if the last populated row has an entry in column G. As I understand the entry could be in any column from A to G.
If indeed so, try this code:

 
Sub DeleteBlankRows()
Dim V_LastRow As Long, V_DeletedRows As Long
Application.ScreenUpdating = False
V_LastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
Range("A2").Select
V_DeletedRows = 0
Do Until ActiveCell.Row = V_LastRow - V_DeletedRows
    If WorksheetFunction.CountA(ActiveCell.EntireRow) = 0 Then
        ActiveCell.EntireRow.Delete
        V_DeletedRows = V_DeletedRows + 1
        ActiveCell.Offset(-1, 0).Select
    End If
    ActiveCell.Offset(1, 0).Select
Loop
Range("A2").Select
Application.ScreenUpdating = True
End Sub

Open in new window


Regards,
Davy
0
 
monboisAuthor Commented:
Thanks, guys, but I only want to delete any a single row that's completely blank between columns B & K and which falls between two rows of information.

If you'll look at the attached graphic, I want code that will delete row 9 because there's not data in columns B-K (formula in col. A and other data in further out columns should be ignored).

I would like for the VBA to kick in when a user completes the first cell in a row skipping a row. In the graphic, it would be great if the VBA immediately deleted row 9 after the user selected YES in C10.

Does this help?

Thanks again!
Delete-Row.jpg
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
Davy2270Commented:
Ok, paste this code on the sheet module:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("C:C")) Is Nothing Then
        If WorksheetFunction.CountA(ActiveCell.Offset(-1, 0).EntireRow) = 0 Then
            Application.EnableEvents = False
            ActiveCell.Offset(-1, 0).EntireRow.Delete
            Application.EnableEvents = True
        End If
    End If
End Sub
0
 
monboisAuthor Commented:
Davy2270,

I think you're on the right track, but your code seems to be looking for anything in Col. C, which has plenty of data in the top rows.

In the graphic I provided above, the code needs to do is look in all the rows ABOVE the row where data is entered. If all the cells from Col. B to Col. K ("B#?:K#?") are blank, all those rows should be deleted.

The dataset goes down to row 1500 and it would be ideal to insert blank rows at the bottom to replace each deleted row.

Hop you can help me figure it out!

Thanks again!
0
 
Davy2270Commented:
Hi monbois,

the code looks for a changement of cell content only in column C. If a cell value would be changed/entered in any other column than C, the code will not be executed. That's what I understood when you said "it would be great if the VBA immediately deleted row 9 after the user selected YES in C10".
Then if the code detects that a change in column C happened, it will verify whether the neighbour row up is empty. If empty, then delete.
So if I understand correctly the user might skip more than 1 row.  We then should repeat the delete action until we meet a non-empty row:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("C:C")) Is Nothing Then
        Application.EnableEvents = False
        Do Until WorksheetFunction.CountA(ActiveCell.Offset(-1, 0).EntireRow) <> 0
                        ActiveCell.Offset(-1, 0).EntireRow.Delete
                        ActiveCell.Offset(-1, 0).Select
        Loop
        Application.EnableEvents = True
    End If
End Sub
0
 
kgerbChief EngineerCommented:
monbois,
This code will delete the row if all the cells between column B and K are blank.  It will also add a row to the bottom of the data set for each row that is deleted (to preserve formatting I guess?).  Let me know if you need anything else.

Like I said before, it will just highlight the rows red for now.  When you are sure it's working properly remove the comment from this line
'Rw.EntireRow.Delete

Open in new window

and delete this line
Rw.EntireRow.Interior.ColorIndex = 3

Open in new window

Then if will delete the row instead of just coloring it.

Kyle
Sub DeleteBlankRows()
Dim Rw As Range, rng As Range, rngSel As Range, i As Long
Dim Lrow As Long
Lrow = Cells.Find("*", searchdirection:=xlPrevious).Row
Set rng = Range("B6", Cells(Lrow, "K"))
Set rng = rng.SpecialCells(xlCellTypeBlanks)
For Each Rw In rng.Rows
    If WorksheetFunction.CountA(Rw.EntireRow) = 0 Then
        'Rw.EntireRow.Delete
        Rw.EntireRow.Interior.ColorIndex = 3
        Rows(Cells.Find("*", searchdirection:=xlPrevious).Row + 1).Insert Shift:=xlDown
    End If
Next Rw
End Sub

Open in new window

0
 
Davy2270Commented:
Addition:

if you want the code to kick in when a cell value gets changed/entered in any column from B to K then change ("C:C") to ("B:K")

if you want to insert a new row at the bottom of your table after deleting another one, then use this code:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("C:C")) Is Nothing Then
        Application.EnableEvents = False
        Do Until WorksheetFunction.CountA(ActiveCell.Offset(-1, 0).EntireRow) <> 0
                        ActiveCell.Offset(-1, 0).EntireRow.Delete
                        ActiveCell.Offset(-1, 0).Select
                        Range("A1499").EntireRow.Insert
        Loop
        Application.EnableEvents = True
    End If
End Sub
0
 
monboisAuthor Commented:
Davy2270 and kgerb,

Thanks for the possible solutions, guys, but unfortunately neither one is working. I've stepped through each one and they each just loop and loop but never recognize any empty row per the parameters of my situation.

Got anything else?

Thanks.
0
 
kgerbChief EngineerCommented:
Can you post your workbook or at least the sheet in question.  That will help us figure out why it's not working for your situation.

Kyle
0
 
Davy2270Commented:
Yes, please share your file/sheet.
0
 
monboisAuthor Commented:
kgerb,

Please see the graphic in my comment above. Davy2270 thought I only wanted the VBA to kick in if a value was entered in Col. C, but that's just in the example graphic; I'd like it to execute if a value is entered into any cell of a new row B:K. The more I think about this, there's no need to run the code again if there's already a value in another cell of the row because any blank rows between that row and the rows above should have already been executed.

Thanks.
0
 
Davy2270Commented:
If I mimic the picture you have shown and run this code from the worksheetmodule, it works fine, if it doesn't for you, could you then share you workbook/sheet?

 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("B:K")) Is Nothing Then
        Application.EnableEvents = False
        Do Until WorksheetFunction.CountA(Range("B" & ActveCell.Offset(-1, 0).Row & ":K" & ActiveCell.Offset(-1, 0).Row & "")) <> 0
                        ActiveCell.Offset(-1, 0).EntireRow.Delete
                        ActiveCell.Offset(-1, 0).Select
                        Range("A1499").EntireRow.Insert
        Loop
        Application.EnableEvents = True
    End If
End Sub

Open in new window


regards,
Davy
0
 
monboisAuthor Commented:
kgerb,

I've pared down the Excel file to this single spreadsheet, per your request.

Thanks! Delete-Blank-Rows-Example.xls
0
 
kgerbChief EngineerCommented:
Take a look at this.  I think it will do what you want.  Took a little more work than I thought but seems to be working.

Kyle
Sub DeleteBlankRows()
Dim Rw As Range, rng As Range, rngSel As Range, i As Long
Dim Lrow As Long, arrRows() As Long
ReDim arrRows(1)
Lrow = Range("B6", Cells(Rows.Count, "K")).Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
Set rng = Range("B6", Cells(Lrow, "K"))
Set rng = rng.SpecialCells(xlCellTypeBlanks)
For Each Rw In rng.Rows
    If WorksheetFunction.CountA(Range(Cells(Rw.Row, "B"), Cells(Rw.Row, "K"))) = 0 Then
        If RowAlreadyRecorded(Rw.Row, arrRows()) = False Then
            arrRows(UBound(arrRows)) = Rw.Row
            ReDim Preserve arrRows(UBound(arrRows) + 1)
        End If
    End If
Next Rw
If UBound(arrRows) > 1 Then ReDim Preserve arrRows(UBound(arrRows) - 1) Else Exit Sub
For i = UBound(arrRows) To 1 Step -1
    Application.EnableEvents = False
    Rows(arrRows(i)).Delete
    Rows(Range("B:K").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row + 1).Insert Shift:=xlDown
    Application.EnableEvents = True
Next i
End Sub

Open in new window

Q-27400990-RevB.xlsm
0
 
monboisAuthor Commented:
Thanks, kgerb, but this immediately returned a Comile Error (see attached screen shot).  I pasted it as a sub-routine directly into the spreadsheet's own Worksheet_Change routine so it immediately kicks in as soon as I enter a value on a new row, leaving a blank row.

Why does it work for you and not for me?   :-(

Thanks.
Delete-Blank-Row-Error-01.jpg
0
 
kgerbChief EngineerCommented:
monbois,
Sorry, posting only part of the code was confusing.  I meant for you to look in the attached example workbook and get the rest.  Here is the whole thing including the worksheet change event.  RowAlreadyRecorded is a little function that plays a supporting role.  Please refer to my example workbook if you want to see it work or where it goes.

Thanks
Kyle
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Err_Worksheet_Change

Call DeleteBlankRows

Exit_Worksheet_Change:
    Exit Sub

Err_Worksheet_Change:
    MsgBox Err.Description
    Resume Exit_Worksheet_Change
End Sub

Sub DeleteBlankRows()
Dim Rw As Range, rng As Range, rngSel As Range, i As Long
Dim Lrow As Long, arrRows() As Long
ReDim arrRows(1)
Lrow = Range("B6", Cells(Rows.Count, "K")).Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
Set rng = Range("B6", Cells(Lrow, "K"))
Set rng = rng.SpecialCells(xlCellTypeBlanks)
For Each Rw In rng.Rows
    If WorksheetFunction.CountA(Range(Cells(Rw.Row, "B"), Cells(Rw.Row, "K"))) = 0 Then
        If RowAlreadyRecorded(Rw.Row, arrRows()) = False Then
            arrRows(UBound(arrRows)) = Rw.Row
            ReDim Preserve arrRows(UBound(arrRows) + 1)
        End If
    End If
Next Rw
If UBound(arrRows) > 1 Then ReDim Preserve arrRows(UBound(arrRows) - 1) Else Exit Sub
For i = UBound(arrRows) To 1 Step -1
    Application.EnableEvents = False
    Rows(arrRows(i)).Delete
    Rows(Range("B:K").Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row + 1).Insert Shift:=xlDown
    Application.EnableEvents = True
Next i
End Sub

Function RowAlreadyRecorded(r As Long, arr() As Long)
Dim j As Long
For j = 1 To UBound(arr)
    If arr(j) = r Then
        RowAlreadyRecorded = True
        Exit Function
    End If
Next j
RowAlreadyRecorded = False
End Function

Open in new window

0
 
Davy2270Commented:
See the attached file. I think it should be working fine now.
It seems that excel had trouble with the counta formula, instead i used the countblank.
I adjusted the code, and it seemed to work ok.
Please test and feedback.

Regards,
Davy
Copy-Delete-Blank-Rows-Example.xls
0
 
monboisAuthor Commented:
Very slick and much appreciated solution! I had to disable the line:

ActiveCell.Offset(-1, 0).Select

This works in expert's solution, but in mine it throws the makes the cell above the current cell the ActiveCell, and then looks in the row above THAT to see if it's blank. But that row's actually 2 rows above the one where the initial value is entered.

Minor adjustment, though, and it works great!

THANKS!!!     :-)
0
 
monboisAuthor Commented:
Davy2270.

I discovered that I have to remove the row offset:

ActiveCell.Offset(-1, 0).Select

when a dropdown list is in play, in which case the cursur doesn't move to the next cell down after hitting ENTER. A simple IF statement specifying columns resolves the issue.

Thanks again!
0
 
Davy2270Commented:
That's correct monbois!
I did not see any dropdownlists in your shared workbook. However at the right of columns B-K there's a list stating dropdownlists for specific columns, eventually to be added.
So, good thinking and code tweaking from your side.
You did exactly what was needed.

Regards,
Davy

0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

  • 8
  • 8
  • 5
Tackle projects and never again get stuck behind a technical roadblock.
Join Now