CODEWITHSUNDEEP
vbaexcel
M Mayer
M Mayer

Reputation: 17

Excel Macro, read a worksheet, remove lines with no data based off value in a column

I'm trying to read a column, which has a numerical value, to indicate whether or not to search that row to see if there is any data contained within the specified range of that row. If there is no data contained within the range, select that row to be deleted. There will be many rows to be deleted once it has looped through the worksheet.

For example, in column "C" when the value "0" is found, search that row to see if there is any data contained in the cells, the cell range to search for empty cells in that row is D:AM. If the cells in the range are empty, then select that row and delete it. The entire row can be deleted. I need to do this for the entire worksheet, which can contain up to 20,000 rows. The problem I'm having is getting the macro to read the row, once the value 0 is found, to determine if the range of cells(D:AM) are empty. Here is the code I have thus far:

Option Explicit
Sub DeleteBlankRows()
  'declare variables
  Dim x, curVal, BlankCount As Integer
  Dim found, completed As Boolean
  Dim rowCount, rangesCount As Long
  Dim allRanges(10000) As Range
  'set variables
  BlankCount = 0
  x = 0
  rowCount = 2
  rangesCount = -1
  notFirst = False
  'Select the starting Cell
  Range("C2").Select
  'Loop to go down Row C and search for value
  Do Until completed
     rowCount = rowCount + 1

     curVal = Range("C" & CStr(rowCount)).Value
     'If 0 is found then start the range counter
     If curVal = x Then
         found = True
         rangesCount = rangesCount + 1
         'reset the blanks counter
         BlankCount = 0
         'Populate the array with the correct range to be selected
         Set allRanges(rangesCount) = Range("D" & CStr(rowCount) & ":AM" & CStr(rowCount))

     ElseIf (found) Then
        'if the cell is blank, increment the counter
        If (IsEmpty(Range("I" & CStr(rowCount)).Value)) Then BlankCount = BlankCount + 1
        'if counter is greater then 20, reached end of document, stop selection
        If BlankCount > 20 Then Exit Do
     End If
     'In the safest-side condition to avoid an infinite loop in case of not of finding what is intended.
     If (rowCount >= 25000) Then Exit Do
  Loop

  If (rangesCount > 0) Then
     'Declare variables
     Dim curRange As Variant
     Dim allTogether As Range
     'Set variables
     Set allTogether = allRanges(0)
     For Each curRange In allRanges
           If (Not curRange Is Nothing) Then Set allTogether = Union(curRange, allTogether)
     Next curRange
     'Select the array of data
     allTogether.Select
     'delete the selection of data
     'allTogether.Delete
  End If
End Sub

The end of the document is being determined by Column C when it encounters 20 or more blank cells the worksheet has reached its end. Thanks in advance for your input!

Upvotes: 0

Views: 1729

Answers (1)

tigeravatar
tigeravatar

Reputation: 26660

This should work for you. I have commented the code to help give it clarity:

Sub DeleteBlankRows()

    Dim rngDel As Range
    Dim rngFound As Range
    Dim strFirst As String

    'Searching column C
    With Columns("C")
        'Find "0" in column C
        Set rngFound = .Find(0, .Cells(.Cells.Count), xlValues, xlWhole)
        If Not rngFound Is Nothing Then
            'Remember first one found
            strFirst = rngFound.Address
            Do

                'Check if there is anything within D:AM on the row of this found cell
                If WorksheetFunction.CountA(Intersect(rngFound.EntireRow, .Parent.Range("D:AM"))) = 0 Then
                    'There is nothing, add this row to rngDel
                    Select Case (rngDel Is Nothing)
                        Case True:  Set rngDel = rngFound
                        Case Else:  Set rngDel = Union(rngDel, rngFound)
                    End Select
                End If

                'Find next "0"
                Set rngFound = .Find(0, rngFound, xlValues, xlWhole)

            'Advance loop; exit when back to the first one
            Loop While rngFound.Address <> strFirst
        End If
    End With

    'Delete all rows added to rngDel (if any)
    If Not rngDel Is Nothing Then rngDel.EntireRow.Delete

End Sub

Upvotes: 1

Related Questions