Move Row to different Workesheet based on numerical value using excel vba

Question

I have a worksheet filled with inventory data. Before using that data to create reports I'd like to check it for integrity. Mostly I want to check if there are cells filled with zeros or if one value might be bigger than another (which should not be possible). All values (or rather the whole column they're in) which match those criteria should then be moved to another worksheet for further inspection. My code so far looks like this:

Sub CheckData()
Dim SourceSheet As Worksheet
Dim TargetSheet As Worksheet
Dim i As Long
Dim LR As Long

Last_Column = Worksheets("data").Cells(1, Columns.Count).End(xlToLeft).Column
For y = 1 To Last_Column
    HeadLine = Worksheets("data").Cells(1, y)
    If HeadLine = "Headline1" Then
        Col_H1 = y
    End If
    If HeadLine = "Headline2" Then
        Col_H2 = y
    End If
Next y


Set SourceSheet = Sheets("data")
Set TargetSheet = Sheets("error")


With SourceSheet
LR = .Range("A" & .Rows.Count).End(xlUp).Row

    For i = 2 To LR
        If Sheets("data").Cells(i, Col_H1).Value = 0 Then
        x = TargetSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
        SourceSheet.Rows(i).Copy TargetSheet.Rows(x)
        'SourceSheet.Rows(i).Delete
        End If
    Next i
End With    
End Sub

Now in theory this should check whether there is a cell with the value 0 in the column with the Headline "Headline1". However, while it does copy some row which are correct (value of zero) it also copies at least as much rows for which my statement does not apply. The same thing happens if I check whether one value is bigger than another. For testing purposes the copied rows are not yet deleted, thats why that line is commented out.

Answer 1

You should modify the part of your code snippet to work properly like shown below:

'clear the target worksheet
TargetSheet.Cells.Clear
With SourceSheet
    LR = .Range("A" & .Rows.Count).End(xlUp).Row
    'loop in reverse order because of Delete operation moves up the rest
    For i = LR To 2 Step -1
        If .Cells(i, Col_H1).Value = 0 Then
            x = TargetSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
            .Rows(i).Copy TargetSheet.Rows(x)
            .Rows(i).Delete
        End If
    Next i
End With

Hope this may help.

Answer 2

Hope this answer could help you:

Sub CheckData()
    Dim SourceSheet As Worksheet
    Dim TargetSheet As Worksheet
    Dim i As Long
    Dim LR As Long
    Dim Last_Column
    Dim HeadLine
    Dim y
    Dim Col_H1
    Dim Col_H2
    Dim x
    'Well as a good practice, (I) always declare any variable

    Set SourceSheet = Sheets("data") 'set the Worksheets vars
    Set TargetSheet = Sheets("error")

    SourceSheet.Activate 'go to data

    Last_Column = SourceSheet.Cells(1, Columns.Count).End(xlToLeft).Column
    For y = 1 To Last_Column
        HeadLine = SourceSheet.Cells(1, y)
        If HeadLine = "Headline1" Then 'Then loop over the cells inside the column
            With SourceSheet
                LR = .Range("A" & .Rows.Count).End(xlUp).Row
                For i = 2 To LR 'here we test if the value is 0
                    If .Cells(i, y).Value = 0 Then
                        x = TargetSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
                        .Rows(i).Copy TargetSheet.Rows(x)
                        'SourceSheet.Rows(i).Delete
                    End If
                Next i
            End With
        End If
        If HeadLine = "Headline2" Then
            With SourceSheet
                LR = .Range("A" & .Rows.Count).End(xlUp).Row
                For i = 2 To LR
                    If .Cells(i, y).Value = 0 Then
                        x = TargetSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
                        .Rows(i).Copy TargetSheet.Rows(x)
                        'SourceSheet.Rows(i).Delete
                    End If
                Next i
            End With
        End If
    Next y
End Sub

NOTE:

Don't know why you got this code

 For i = 2 To LR
        If Sheets("data").Cells(i, Col_H1).Value = 0 Then
        i = i + 1 <===== WRONG
        x = TargetSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
        SourceSheet.Rows(i).Copy TargetSheet.Rows(x)
        'SourceSheet.Rows(i).Delete
        End If
    Next i

Because of that code your code copy the next row with 0 value, not the required row.