VBA, If all rows in Col A is filled and Col B is blank(and vice versa) then copy those rows to a new-CodePudding

I am trying to incorporate the following logic, If all rows in Col A is filled and Col B is blank(and vice versa) then copy those rows to a new sheet.

Here is what I have so far:

Sub DataValidation()

    Dim rng As Range
    Dim cell As Range

    Set rng = Range("A:B")

    For Each cell In rng
        
    If Cel.Value = "" Then
    Sheets("List").Cel.Value.EntireRow.Copy Destination:=Sheets("test").Range("A" & Rows.Count).End(xlUp).Offset(1)
        
    Next cell
    
End Sub

Can anyone help with this? I need help with 1) If.Cel.Value="" , I dont think this identifies the logic for Col A filled and Col B is blank. 2) And I need help identifying these rows and copying to a new tab.

CodePudding user response：

First off, your reference to cell.value has a typo, it needs to be cell.value

As for the solution, just like Bigben said, a Range.AutoFilter is probably the simplest option here without Advanced Filters.

You'll be looking for something like this

rng.AutoFilter Field:=1, Criteria1:="<>" 'This will filter by non-blanks in Column 1

rng.AutoFilter Field:=2, Criteria1:="=" 'This will filter by blanks in Column 2

When a range is filtered, if you use rng, it will still refer to the entire range including those hidden (essentially ignoring the filter). This is why you should now use rng.specialCells(xlCellTypeVisible) to now refer to the displaying range.

Mix and match filters and then use rng.specialCells(xlCellTypeVisible).Copy

CodePudding user response：

Please, try the next way. It uses an array and builds a Union range, to be copied at the code end. That's why is should be much faster than iterating between all cells and copying a row at a time:

Sub DataValidation()
    Dim ws As Worksheet, lastR As Long, arr, rngCopy As Range, i As Long

    Set ws = ActiveSheet
    lastR = ws.Range("A" & ws.rows.count).End(xlUp).row
    arr = ws.Range("A1:B" & lastR).Value2 'place the range in an array for faster iteration/processing

    For i = 2 To UBound(arr) '2 supposing that headers exist on the first row
        If (arr(i, 1) <> "" And arr(i, 2) = "") Or (arr(i, 2) <> "" And arr(i, 1) = "") Then
            addToRange rngCopy, ws.Range("A" & i)
        End If
    Next i
        
   If Not rngCopy Is Nothing Then rngCopy.EntireRow.Copy _
         Sheets("test").Range("A" & rows.count).End(xlUp).Offset(1)
End Sub

Sub addToRange(rngU As Range, rng As Range)
    If rngU Is Nothing Then
        Set rngU = rng
    Else
        Set rngU = Union(rngU, rng)
    End If
End Sub