Using CountA or Equivelant on a range of columns contained within a larger array of columns-CodePudding

I am currently reading a range into an array to perform a few calculations before outputting into another worksheet. My reason for using the array is speed as I am often dealing with thousands of rows.

I have one particular calculation that I am struggling with for some reason.

This is the part I am struggling with (rest of sample of this code is further down):

For i = non_rev_rows To 2 Step -1.


**' Remove Blank Rows from array
    If data_range(i, 2) = "No WBS/CC" Then
        If Application.WorksheetFunction.CountA(Range("C" & i & ":M" & i)) = 0 Then
            Rows(i).Delete
        End If

So basically when a row in column 2 is equal to "No WBS/CC" then I need to run a CountA or any other method you can recommend to calcuate the total value of columns C to M on that row. I am essentially looking for any row that = "No WBS/CC" and where columns C:M have no value. If so, then delete the entire row. If there is a value in columns C:M then I would not wish to delete the row.

'Row Count
With Sheets("array")
     non_rev_rows = .Range("E" & .Rows.Count).End(xlUp).Row
End With

' Remove Blank Rows from array
' Replace "NO WBS/CC" with Co Code Over-Ride if supplied
' Set Debit / Credit
' Round to 2 decimal places
Set data = array_sheet.Range("A1:M" & non_rev_rows)
data_range = data.Value

For i = non_rev_rows To 2 Step -1.


**' Remove Blank Rows from array
    If data_range(i, 2) = "No WBS/CC" Then
        If Application.WorksheetFunction.CountA(Range("C" & i & ":M" & i)) = 0 Then
            Rows(i).Delete
        End If
        
        ' Replace "NO WBS/CC" with Co Code Over-Ride if supplied
        If data_range(i, 13) <> 0 Then
            data_range(i, 2) = data_range(i, 13)
        End If
        
    End If**
    
' Set Debit / Credit
    data_range(i, 3) = Replace(data_range(i, 3), "Debit", 41)
    data_range(i, 3) = Replace(data_range(i, 3), "Credit", 51)
    
' Round to 2 decimal places
    data_range(i, 5) = WorksheetFunction.Round(data_range(i, 5), 2)
    
'    If data_range(i, 3) = "Debit" Then
'        data_range(i, 3).Value = 41
'    ElseIf data_range(i, 3) = "Credit" Then
'        data_range(i, 3).Value = 51
'    End If
    

    
   
    'data_range(i, 5).Value = Application.WorksheetFunction.Round(Range(data_range(i, 5)).Value, 2)
    'Range("E" & i).Value = Application.WorksheetFunction.Round(Range("E" & i).Value, 2)
    
Next i

**' Remove Blank Rows from array
    If data_range(i, 2) = "No WBS/CC" Then
        If Application.WorksheetFunction.CountA(Range("C" & i & ":M" & i)) = 0 Then
            Rows(i).Delete
        End If

This code does not result in an error but it also does not have the desired impact. I have several rows in my test data that contain "No WBS/CC" in column 2 and zero values in columns C:M but the code is not deleting those rows.

CodePudding user response：

You can do both tests on the array rather than partially in array and partially in the worksheet.
Only delete the row in the worksheet when you find a full match.

Public Sub Test2()

Dim data_range As Variant
Dim lRows As Long
Dim lColumns As Long
Dim lCounter As Long

data_range = Sheet1.Range("A1:M6")
' Add the data to an array

For lRows = UBound(data_range) To LBound(data_range) Step -1
'Step through the array in reverse
    If data_range(lRows, 2) = "No WBS/CC" Then
'Check for the "No WBS/CC" value in the second column of the array
        
        lCounter = 0
'Reset the counter

        For lColumns = 3 To 13
             If Not IsEmpty(data_range(lRows, lColumns)) Then
                lCounter = lCounter   1
             End If
        Next lColumns
'Check columns in the array row to see if they have data
'Add to the counter for each cell having value
        
        If lCounter = 0 Then
            Sheet1.Rows(lRows).EntireRow.Delete
        End If
'If the counter is zero delete the current row in the Workbook

    End If
Next lRows


End Sub

Sample data before the macro is run. The row we expected to be removed highlighted in green.

Sample data after the macro is run. The expected row has been removed.

An alternate option is to write the valid rows to a new array.
Clear the data on the worksheet, then write the new array to the worksheet.

CodePudding user response：

Remove Rows

Sub DoStuff()

    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet: Set ws = wb.Worksheets("Array")
    
    Dim LastRow As Long: LastRow = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row
    
    Dim rg As Range: Set rg = ws.Range("A2", ws.Cells(LastRow, "M"))
    Dim rCount As Long: rCount = rg.Rows.Count
    Dim cCount As Long: cCount = rg.Columns.Count
    
    Dim Data() As Variant: Data = rg.Value
    
    Dim sr As Long
    Dim dr As Long
    Dim c As Long
    
    For sr = 1 To rCount
        If Not IsRowBlank(Data, sr, 3, 13) Then ' is not blank
            ' Replace "NO WBS/CC" with Co Code Over-Ride if supplied
            If CStr(Data(sr, 1)) = "No WBS/CC" Then
                If Data(sr, 13) <> 0 Then
                    Data(sr, 2) = Data(sr, 13)
                End If
            End If
            ' Set Debit / Credit
            Data(sr, 3) = Replace(Data(sr, 3), "Debit", 41)
            Data(sr, 3) = Replace(Data(sr, 3), "Credit", 51)
            ' Round to 2 decimal places
            Data(sr, 5) = Application.Round(Data(sr, 5), 2)
            ' Copy source row to destination row.
            dr = dr   1
            For c = 1 To cCount
                Data(dr, c) = Data(sr, c)
            Next c
        'Else ' is blank; do nothing
        End If
    Next sr

    ' Clear bottom source data.
    If dr < rCount Then
        For sr = dr   1 To rCount
            For c = 1 To cCount
                Data(sr, c) = Empty
            Next c
        Next sr
    End If
                     
    rg.Value = dData

End Sub

Function IsRowBlank( _
    Data() As Variant, _
    ByVal DataRow As Long, _
    ByVal StartColumn As Long, _
    ByVal EndColumn As Long) _
As Boolean
    Dim c As Long
    For c = StartColumn To EndColumn
        If Len(CStr(Data(DataRow, c))) > 0 Then Exit For
    Next c
    IsRowBlank = c > EndColumn
End Function