CODEWITHSUNDEEP
excelvbaloopsrangecell
Dmitriy
Dmitriy

Reputation: 37

Deleting Non-Contiguous Range Based on Blank Cells

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.
For instance

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?

Upvotes: 0

Views: 292

Answers (2)

SnowGroomer
SnowGroomer

Reputation: 695

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

Upvotes: 1

T.M.
T.M.

Reputation: 9948

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:-)

Upvotes: 1

Related Questions