Deleting Non-Contiguous Range Based on Blank Cells

Question

I want my code to take a user defined range and delete any blank cells as well as the cell one to the right of the blank cell.

Here is what I have so far:

Sub CleanupAccountsinYear()

Dim selectedrng As Range

Range(Selection, Selection).Select

Set selectedrng = Application.Selection


For Each Cell In selectedrng

    If Cell.Value = "" Then
    Cell.Activate
    Range(ActiveCell, Cells((ActiveCell.Row), (ActiveCell.Column) + 1)).Select
    'Missing Vital Component
    End If
         
Next Cell
End Sub

The problem is that each time I delete the selected range and the macro moves on to the next cell it will skip a cell. My thinking is I may have to store the ranges in a union and delete them from there but that has proven to be a bit difficult. Is there an easier way to solve this?

If you are deleting cells you need to iterate from the last cell to the first. If you go from 1 to n, you will skip every other cell. Basically make your For loop like this: For row = totalRows to 1 step -1 — SnowGroomer, May 27 '21 at 18:04
@SnowGroomer so I should delete the loop dealing with cells? — Dmitriy, May 27 '21 at 19:44
I have posted my suggestion as an answer - this way it will be clearer what I meant, I hope. — SnowGroomer, May 28 '21 at 07:41

score 1 · Answer 1 · answered May 27 '21 at 19:28

Is there an easier way to solve this?

If you dispose of MS/Excel 365 (see FILTER formula) and assuming 2 column ranges you can profit from the new dynamic array features by

Step 1..2 evaluating the Excel formula FILTER (vs. MS/Excel 365),
Step 3 rearranging the array values of the data range via Application.Index() and
Step 4 overwriting the original data

as follows:

Sub ExcludeBlanks(rng As Range)
'1. build individual formula
    Dim myFormula As String: myFormula = "FILTER(ROW($),$<>0,"""")"
    myFormula = Replace(myFormula, "$", rng.Address(False, False, external:=True))
'2. get array of row numbers to maintain
    Dim rowNums: rowNums = Evaluate(myFormula)
'3. a) get data (consisting of 2 columns)
    Dim data:    data = rng.Resize(ColumnSize:=2).Value2
'   b) rearrange data (based on rowNums to maintain & first two columns)
    data = Application.Index(data, rowNums, Array(1, 2))
'4. overwrite original range by rearranged data (INDEX)
    rng.Clear
    rng.Resize(UBound(data), UBound(data, 2)) = data
End Sub

Note to prior versions of MS/Excel

Of course you can also build a (vertical) 2-dimensional array by looping through the original data isolating element/row numbers of non-blanks:-)

score 1 · Accepted Answer · answered May 28 '21 at 07:41

Here is how I would generally approach deleting rows where the first column is empty. Notice that the for loops iterates backwards - this eliminates row skipping observed when iterated forwards from 1 to row count.

Sub RemoveRowsWithBlankFirstColumn()
  Dim rng As Range
  Set rng = Application.Selection
  Dim i As Integer
  For i = rng.Rows.Count To 1 Step -1
    If rng.Cells(i, 1).Value2 = vbNullString Then
      rng.Cells(i, 1).EntireRow.Delete
    End If
  Next i
End Sub

Deleting Non-Contiguous Range Based on Blank Cells

2 Answers2