Search Range for Value Change, Copy Whole Row if Found - vba

Question

I'm very new to VBA (~4 days new) and have tried to solve this issue in my usual method, through reading lots of different posts on resources like this and experimenting, but have not been able to quite get the hang of it. I hope you fine folks are willing to point out where I'm going wrong with this. I've looked at a lot (all?) of the threads with similar issues but haven't been able to cobble together a solution for myself from them. I hope you'll forgive this if it has already been answered somewhere else.
Context:
I've got a spreadsheet with items in rows 5-713 down column B (merged up to cell J) where for each date (Columns K-SP) the item is scored either a 1 or a 0. My goal is to create a list at the bottom of the worksheet that contains all items which have gone from 1 to 0. To start, I've simply been trying to get my "generate list" button to copy all rows with a 0 in them to the bottom, figuring I would tweak it later to do exactly what I wanted. I've tried several things and gotten several different errors.
Worksheet Sample for a visual of what I'm talking about.
I've gone through several different attempts and have had limited success with each, usually getting a different error every time. I've had "method 'range of object' _Worksheet failed", "object required", "type mismatch", "out of memory", and a few others. I'm sure I'm simply not grasping some of the basic syntax, which is causing some problems.
Here is the latest batch of code, giving me the error 'type mismatch'. I've also tried having 'todo' be string but that just shoots out 'object required'
Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim y As Integer, z As Integer, todo As Range
Set todo = ThisWorkbook.ActiveSheet.Range(Cells(5, 2), Cells(713, 510))
y = 5
z = 714
With todo
Do
If todo.Rows(y).Value = 0 Then
todo.Copy Range(Cells(z, 2))
y = y + 1
z = z + 1
End If
Loop Until y = 708
End With
Application.ScreenUpdating = True
End Sub
Another attempt I thought was promising was the following, but it gives me 'out of memory'.
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim y As Integer, z As Integer
y = 5
z = 714
Do
If Range("By:SPy").Value = 0 Then
Range("By:SPy").Copy Range("Bz")
y = y + 1
z = z + 1
End If
Loop Until y = 708
Application.ScreenUpdating = True
End Sub
Just to reiterate, the code attempts I've posted were simply to get any row containing 0's to the bottom of the spreadsheet, however, if there's a way define the criteria to search for 1's that turn to 0's, that would be amazing! Also, I'm not sure how to differentiate a 0 in the actual data and a zero in the item name (for example, it would not be great to have 'Item 10' go into the list just because 10 is a 1 with a 0 after it).
Any help to figure out this first step, or even how to have it scan for 1's that turn to 0's would be wonderfully appreciated. I'm sure I'm missing something simple and hope you guys can forgive my ignorance.
Thanks!

Answer 1

This looks through the data and copies it down below the last row of the data. It is assuming there is nothing below the data. It also only looks for zeros after it finds a 1.
Sub findValueChange()
Dim lastRow As Long, copyRow As Long, lastCol As Long
Dim myCell As Range, myRange As Range, dataCell As Range, data As Range
Dim hasOne As Boolean, switchToZero As Boolean
Dim dataSht As Worksheet
Set dataSht = Sheets("Sheet1") '<---- change for whatever your sheet name is
'Get the last row and column of the sheet
lastRow = dataSht.Cells(Rows.Count, 2).End(xlUp).row
lastCol = dataSht.Cells(5, Columns.Count).End(xlToLeft).Column
'Where we are copying the rows to (2 after last row initially)
copyRow = lastRow + 2
'Set the range of the items to loop through
With dataSht
Set myRange = .Range(.Cells(5, 2), .Cells(lastRow, 2))
End With
'start looping through the items
For Each myCell In myRange
hasOne = False 'This and the one following are just flags for logic
switchToZero = False
With dataSht
'Get the range of the data (1's and/or 0's in the row we are looking at
Set data = .Range(.Cells(myCell.row, 11), .Cells(myCell.row, lastCol))
End With
'loop through (from left to right) the binary data
For Each dataCell In data
'See if we have encountered a one yet
If Not hasOne Then 'if not:
If dataCell.Value = "1" Then
hasOne = True 'Yay! we found a 1!
End If
Else 'We already have a one, see if the new cell is 0
If dataCell.Value = "0" Then 'if 0:
switchToZero = True 'Now we have a zero
Exit For 'No need to continue looking, we know we already changed
End If
End If
Next dataCell 'move over to the next peice of data
If switchToZero Then 'If we did find a switch to zero:
'Copy and paste whole row down
myCell.EntireRow.Copy
dataSht.Cells(copyRow, 2).EntireRow.PasteSpecial xlPasteAll
Application.CutCopyMode = False
copyRow = copyRow + 1 'increment copy row to not overwrite
End If
Next myCell
'housekeeping
Set dataSht = Nothing
Set myRange = Nothing
Set myCell = Nothing
Set data = Nothing
Set dataCell = Nothing
End Sub