Having Trouble creating a valid exit condition with Excel VBA

Question

First post all, so forgive any syntax errors: I've been working on a spreadsheet at work for a long time. Its purpose is to log my calls, as I work in a high volume inbound guest services call center. Sometimes I need to follow up with my guests.

Worksheet is Column A:K, starting at Row 5

Ultimately I'm coding a program to check my records, ignore any row that has data in Column K, then when it finds valid data, copy the records to another sheet, and come back to the main sheet. That part works fine and here is the code for that:

Sub Button2_Click()

Dim sourceEmptyRow As Long
Dim targetEmptyRow As Long
Dim sourceRange As Range
Dim targetRange As Range


'Make Today active
 Sheet1.Activate

'Set Variables
 sourceEmptyRow = FindNextEmpty(Range("K5")).Row
 Set sourceRange = Rows(sourceEmptyRow)
 sourceRange.Copy

'Activate Next Sheet
 sheetQ4.Activate

'Set Variables
 targetEmptyRow = FindNextEmpty(Range("A1")).Row
 Set targetRange = Rows(targetEmptyRow)

 targetRange.PasteSpecial
 Sheet1.Activate
 sourceRange.Delete Shift:=xlUp

End Sub

Here is the FindNextEmpty() function (which I'm pretty sure I found here)

Public Function FindNextEmpty(ByVal rCell As Range) As Range
'Finds the first empty cell downwards in a column.

On Error GoTo ErrorHandle

With rCell
   'If the start cell is empty it is the first empty cell.
   If Len(.Formula) = 0 Then
      Set FindNextEmpty = rCell
      'If the cell just below is empty
   ElseIf Len(.Offset(1, 0).Formula) = 0 Then
      Set FindNextEmpty = .Offset(1, 0)
   Else
      'Finds the last cell with content.
      '.End(xlDown) is like pressing CTRL + arrow down.
      Set FindNextEmpty = .End(xlDown).Offset(1, 0)
   End If
End With

Exit Function
ErrorHandle:
MsgBox Err.Description & ", Function FindNextEmpty."
End Function

My PROBLEM is that I'd like to be able to execute this code block, then when its done, check the next row...if BOTH Column A and K are blank to STOP, otherwise Loop back to the top and execute it on the next row. If I have a long day, I can sometimes get 20-30 calls and pushing a button 20-30 times is not efficient.

I have not SERIOUSLY coded since about 2003, so I'm an EXTREME novice. Thanks for any help, ideas, insight you can provide.

Here is my Spreadsheet

Answer 1

This uses the AutoFilter

---

Option Explicit

Public Sub MoveCompleted()
    Const COL_K = 11
    Const TOP_ROW = 5
    Dim ws1 As Worksheet:   Set ws1 = sheetToday    '<--- Source sheet
    Dim ws2 As Worksheet:   Set ws2 = sheetQ118     '<--- Destination sheet
    Dim maxRows As Long, ws1ur As Range

    optimizeXL True
    With ws1.UsedRange
        If ws1.AutoFilterMode Then .AutoFilter
        maxRows = .Rows.Count

        .Offset(TOP_ROW - 2).Resize(maxRows - (TOP_ROW - 2)).AutoFilter 'ur + header row

        .AutoFilter Field:=COL_K, Criteria1:="="    'show only blanks in K
        Set ws1ur = .Offset(TOP_ROW - 1).Resize(maxRows - TOP_ROW + 1, .Columns.Count)

        On Error Resume Next
        Set ws1ur = ws1ur.SpecialCells(xlCellTypeVisible)
        If Err.Number <> 0 Then
            Err.Clear
        Else
            ws1ur.Copy ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
            ws1ur.EntireRow.Delete
        End If
        On Error GoTo 0
        .AutoFilter Field:=COL_K
    End With
    optimizeXL False
End Sub

---

Public Sub optimizeXL(Optional ByVal settingsOff As Boolean = True)
    With Application
        .ScreenUpdating = Not settingsOff
        .Calculation = IIf(settingsOff, xlCalculationManual, xlCalculationAutomatic)
        .EnableEvents = Not settingsOff
    End With
End Sub

---

Initial test sheets

Sheet1 sheetQ4

---

Result

Sheet1 sheetQ4