AlSeres
AlSeres

Reputation: 31

Loop stops too soon

The code is supposed to go through a range of data and search for specific variables in two different columns and paste the data in a different sheet. I do not get the right results (Christo and Paid).

Following is the code.

Sub Cop()

    Dim x As Integer
    Dim y As Integer
    Dim z As Integer
    Dim a As Integer
    Dim NumRows As Long

    Sheets("Not_Paid").Select
    If Range("B2") = 1 And Range("B4") = 1 Then
        Sheets("Microinvest").Select
        Range("A1").Select

        ' Set numrows = number of rows of data.
        NumRows = Range(ActiveCell, ActiveCell.End(xlDown)).Rows.Count

        ' Establish "For" loop to loop "numrows" number of times.
        For x = 1 To NumRows
            y = x + 1
            z = x + 7
            a = x - 1
            Sheets("Microinvest").Select
            Range("A" & y).Select
            If ActiveCell.Offset(a, 2) = "Christo" And ActiveCell.Offset(a, 4) = "Paid" Then
                Range("A" & y, "F" & y).Select
                Selection.Copy
                Sheets("Not_Paid").Select
                Range("A" & z).Select
                ActiveSheet.Paste
            End If
        Next
    End If

    Sheets("Not_Paid").Select

End Sub

Here is a sample of the data i am using:

Data Output

I get values Blagoevgrad and NotPaid which should not be picked up. Or at least that is what i was under the impression would happen.

Furthermore, the x variable loops through 84 rows rather than 389 which is the actual row number of my range.

Upvotes: 3

Views: 194

Answers (1)

Alex P
Alex P

Reputation: 12489

I think this works:

Sub Cop()
    Dim nRows As Long, rw As Long, cnt As Long

    cnt = 10 'Start output in row 10 on sheet Not_Paid

    If Worksheets("Not_Paid").Range("B2") = 1 And Worksheets("Not_Paid").Range("B4") = 1 Then

        With Sheets("Microinvest")
            nRows = .Range("A1").End(xlDown).Row

            For rw = 1 To nRows
                If .Range("A" & rw).Offset(0, 2) = "Christo" And .Range("A" & rw).Offset(0, 4) = "Paid" Then
                    .Range("A" & rw & ":F" & rw).Copy Destination:=Worksheets("Not_Paid").Range("B" & cnt)
                    cnt = cnt + 1
                End If
            Next
        End With

    End If
End Sub

Upvotes: 3

Related Questions