CODEWITHSUNDEEP
excelvba
William Humphries
William Humphries

Reputation: 568

Excel VBA is Finding Every Other Cell not Every Cell From Method

Excel VBA is finding every other cell using a method to check for Empty Cells. On the next time running the same macro, it then finds the cell that it skipped over on the last run while again skipping the next instance of an empty cell. If I cycle through the macro a few times, eventually every row without data is getting deleted, as per the purpose of the macro. The rows do shift upward upon deletion of the row one at a time, I will try a Union and delete the Range as stated by @BigBen

When a cell that is empty is found, it checks columns A, B, and D to see if formula is applied, and if a formula exists in that row, the entire row gets deleted.

Dim cel, dataCells As Range
Dim rngBlank, dc As Range
Dim lastRow, cForm, c, blnkRange As String
Dim cycleTimes As Integer

On Error Resume Next

Set dataCells = Range("F2:W2").Cells    'This is header of the table of data
cycleTimes = dataCells.Count            'Number of times to cycle through macro

For Count = 1 To cycleTimes             'I don't want to cycle through macro
    lastRow = Range("N" & Rows.Count).End(xlUp).Row   'To find end of column
    For Each dc In dataCells
        c = Split(Cells(1, dc.Column).Address, "$")(1)    'Column Letter
        blnkRange = c & "3:" & c & lastRow                'Range to look over for empty cells
        Set rngBlank = Range(blnkRange).SpecialCells(xlCellTypeBlanks).Cells
        For Each cel In rngBlank                          '**Skipping Every other Row**
            If Not TypeName(cel) = "Empty" Then
                cForm = "A" & cel.Row & ",B" & cel.Row & ",D" & cel.Row  'Formula check
                If Range(cForm).HasFormula Then
                    cel.EntireRow.Delete
                End If
            End If
        Next
    Next
Next

Excel Range to be Deleted

Upvotes: 0

Views: 97

Answers (1)

William Humphries
William Humphries

Reputation: 568

I was able to use Intersect to find the rows that matched the criteria I was searching for and delete the EntireRow even though the Selection was in separate Rows.

Set dataCells = Range("F2:W2").Cells

lastRow = Range("N" & Rows.Count).End(xlUp).Row  'To find last row to generate range to look through
For Each dc In dataCells                         'Have to perform delete row for every column
    c = Split(Cells(1, dc.Column).Address, "$")(1) 
    blnkRange = c & "3:" & c & lastRow
    Set rngBlank = Range(blnkRange).SpecialCells(xlCellTypeBlanks).EntireRow
    strFormula = "A2:A" & lastRow & ",B2:B" & lastRow & ",C2:C" & lastRow
    Set rngFormula = Range(strFormula).SpecialCells(xlCellTypeFormulas)
    Intersect(rngFormula, rngBlank).EntireRow.Delete (xlShiftUp)  '**THIS helped in deleting Rows**
Next

Upvotes: 0

Related Questions