1

I am trying to create add some code to my macro to add a blank row whenever the value in column "B" is blank. I have the following code, but it is not doing what I want it to. It is entering too many blank rows.

    Columns("B:B").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireRow.Insert
    Sheets("Attendance Audit Hastus").Protect

Any ideas of how I can accomplish this?

3 Answers 3

0

If there are four adjacent/consecutive blank cells like B4:B7, the code in the question will insert four rows above them. Try this. It will insert only one row below the blank cells. So the new row will be B8 if the blank cells are B4:B7

Sub InsertOneRowBelowBlankCells()
Dim BColBlnk As Range, ar As Range
Set BColBlnk = Range("B:B").SpecialCells(xlCellTypeBlanks)
For Each ar In BColBlnk.Areas
    ar.Cells(ar.Rows.Count, 1).Offset(1).EntireRow.Insert
Next
End Sub

EDIT

And if you want one row above the blank cells, replace ar.Cells(ar.Rows.Count, 1).Offset(1).EntireRow.Insert with ar.Cells(1, 1).EntireRow.Insert

For inserting two rows above the blank cells as per comment below

Sub InsertOneRowBelowBlankCells()
Dim BColBlnk As Range, ar As Range
Set BColBlnk = Range("B:B").SpecialCells(xlCellTypeBlanks)
For Each ar In BColBlnk.Areas
    ar.Cells(1, 1).Resize(2, 1).EntireRow.Insert
Next
End Sub
2
  • And if you want one row above the blank cells, replace ar.Cells(ar.Rows.Count, 1).Offset(1).EntireRow.Insert with ar.Cells(1, 1).EntireRow.Insert
    – Naresh
    Aug 6, 2021 at 14:28
  • How can I adapt this to insert two rows above the blank cell @Naresh?
    – z_11122
    Aug 6, 2021 at 15:44
0

In order to get all cells in column "B" until the last one, you can do this:

Last_Cell_In_B = Columns("B:B").SpecialCells(xlCellTypeLastCell).Row
Range("B1", "B" & Last_Cell_In_B).Select

Like this, you only add empty rows inside your array, not outside of it.

0

Your code works perfectly in a standard module, so I think you are trying to use its in a event case, in sheet "Attendance Audit Hastus" right? So you need to double click in your sheet icon in project tree and put this code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim MRange As Range
Set MRange = Range("B:B")
If Not Intersect(Target, MRange) Is Nothing Then
For Each cell In Target
MRange.SpecialCells(xlCellTypeBlanks).Select
Next cell
End If
Application.EnableEvents = False
Selection.EntireRow.Insert
Application.EnableEvents = True
End Sub

Note the Application.EnableEvents = False is used here to prevent prevent an infinite loop of cascading events. After the action you need to set Application.EnableEvents = True to return your normal process.

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.