VBA - Loop not checking conditions

[darekknox]

Hi All,

I have a problem with loop in my code:

Sub test2()

Dim i As Integer
i = 1


Sheets("Sheet1").Activate



For Each row In Range("g2").End(xlDown)

If Cells(i, 13).Value = "ABC" Then
        Range(Cells(i, 19), Cells(i, 27)).Copy
        Sheets("ABC").Activate
        Range("c2:k2").PasteSpecial Paste:=xlPasteValues
        Sheets("ABC").Range("F:F").Calculate

  ElseIf Cells(i, 13).Value = "123" Then
        Range(Cells(i, 19), Cells(i, 27)).Copy
        Sheets("123").Activate
        Range("c2:k2").PasteSpecial Paste:=xlPasteValues
        Sheets("123").Range("F:F").Calculate
Next
end if
End Sub

the problem is if I have two rows with ABC next to eachother, it copies the same values[ (i,19) (i,27)]as for first abc, even if the second one has them different.

The table looks like this:

ABC	123
ABC	546

220

---

[tr]
[td]ABC[/td]
[td]621[/td]
[/tr]

---

I have 3 row with ABC but it copies always "123", I tried to replace If with Select case, but no luck..it still copie values for 1st row, not second. ;/

 

[Joe4]

I see something in your code that sticks out like a sore thumb.
This line does not do what you think it does:

For Each row In Range("g2").End(xlDown)

This does not loop through all the rows in G starting in G2, because Range("g2").End(xlDown) only select one cell, the last one in column G.

If you want all the rows in row G starting in row 2, use this instead:

For Each Row In Range(Range("g2"), Range("g2").End(xlDown))

 

[darekknox]

Thanks for quick reply, but now the code just runs and does nothing.

I have written a second version:

Sub split()

Dim i As Integer


Sheets("Sheet1").Activate


For i = 2 To Range("g2").End(xlDown).row

Select Case Cells(i, 13).Value
    Case Is = "ABC"
        Range(Cells(i, 19), Cells(i, 27)).Copy
        Sheets("ABC").Activate
        Range("c2:k2").PasteSpecial Paste:=xlPasteValues
        Sheets("ABC").Range("F:F").Calculate

    Case Is = "123"
        Range(Cells(i, 19), Cells(i, 27)).Copy
        Sheets("123").Activate
        Range("c2:k2").PasteSpecial Paste:=xlPasteValues
        Sheets("123").Range("F:F").Calculate
END SELECT
NEXT
END SUB

But still it copies only values from 1st row and doesn't copy from others ;/

 

[RCBricker]

Thanks for quick reply, but now the code just runs and does nothing.

I have written a second version:

Sub split()

Dim i As Integer


Sheets("Sheet1").Activate


For i = 2 To Range("g2").End(xlDown).row

Select Case Cells(i, 13).Value
    Case Is = "ABC"
        Range(Cells(i, 19), Cells(i, 27)).Copy
        Sheets("ABC").Activate
        Range("c2:k2").PasteSpecial Paste:=xlPasteValues
        Sheets("ABC").Range("F:F").Calculate

    Case Is = "123"
        Range(Cells(i, 19), Cells(i, 27)).Copy
        Sheets("123").Activate
        Range("c2:k2").PasteSpecial Paste:=xlPasteValues
        Sheets("123").Range("F:F").Calculate
END SELECT
NEXT
END SUB

But still it copies only values from 1st row and doesn't copy from others ;/

try this

Sub test2()

Dim i As Integer, j As Integer, k As Integer
    j = 2
    k = 2
    
    Sheets("Sheet1").Activate
    
    With Sheets("Sheet1")
        For i = 2 To .Cells(.ROWS.Count, "G").End(xlUp).Row
            Sheets("Sheet1").Select
            If Cells(i, 13).Value = "ABC" Then
                    Range(Cells(i, 19), Cells(i, 27)).Copy
                    Sheets("ABC").Select
                    With Sheets("ABC")
                        Range(.Cells(j, 3), .Cells(j, 11)). _
                            PasteSpecial Paste:=xlPasteValues
                        Range("F:F").Calculate
                    End With
                    j = j + 1
            ElseIf Cells(i, 13).Value = "123" Then
                    Range(Cells(i, 19), Cells(i, 27)).Copy
                    Sheets("123").Select
                    With Sheets("123")
                    Sheets("123").Activate
                    Range(.Cells(k, 3), .Cells(k, 11)). _
                        PasteSpecial Paste:=xlPasteValues
                    Range("F:F").Calculate
                    End With
                    k = k + 1
            End If
        Next
    End With
End Sub

 

[darekknox]

Hi,

Still no luck. However I tried to code it on smaller amount of data and I think I know where the issue comes from:

Sub test()

Dim i As Integer


Sheets("Sheet1").Activate

'Dodac petle - tak aby makro wykonywalo proces dla kazdego wiersza

For i = 3 To Range("c2").End(xlDown).Row


Select Case Cells(i, 1).Value
    Case Is = "ABC"
        Range(Cells(i, 4), Cells(i, 6)).Copy
        Sheets("ABC").Activate
        Range("c2:k2").PasteSpecial Paste:=xlPasteValues
        Sheets("ABC").Range("F:F").Calculate

    Case Is = "DEF"
        Range(Cells(i, 4), Cells(i, 6)).Copy
        Sheets("DEF").Activate
        Range("c2:k2").PasteSpecial Paste:=xlPasteValues
        Sheets("DEF").Range("F:F").Calculate
        
next

End Select
end Sub

With this aprt code, works as it should. It copies the required data every time for a new row till the end. But when I add a part of the code I want to be done next:
The Whole code looks:

Sub test()

Dim i As Integer


Sheets("Sheet1").Activate



For i = 3 To Range("c2").End(xlDown).Row


Select Case Cells(i, 1).Value
    Case Is = "ABC"
        Range(Cells(i, 4), Cells(i, 6)).Copy
        Sheets("ABC").Activate
        Range("c2:k2").PasteSpecial Paste:=xlPasteValues
        Sheets("ABC").Range("F:F").Calculate

    Case Is = "DEF"
        Range(Cells(i, 4), Cells(i, 6)).Copy
        Sheets("DEF").Activate
        Range("c2:k2").PasteSpecial Paste:=xlPasteValues
        Sheets("DEF").Range("F:F").Calculate
        


End Select
Next
Sheets("Sheet1").Activate
For i = 3 To Range("c2").End(xlDown).Row
If Cells(i, 1) = "ABC" And Cells(i, 2) = "1" Then
    
    Sheets("Sheet4").Activate
    Rows("5:5").Select
    'Range("K5").Activate
    
    Selection.AutoFilter
    ActiveSheet.Range("$A$5:$M5").AutoFilter Field:=11, Criteria1:="<>"
    Range(Range("a6"), Cells(Rows.Count, "g").End(xlUp)).SpecialCells(xlVisible).Copy
'zrobic kopiowanie range od a do g

   ' ActiveSheet.UsedRange.Offset(5, 0).SpecialCells _
    '(xlCellTypeVisible).Copy
    
    Sheets("Sheet5").Activate
    Cells(Rows.Count, 3).End(xlUp).Offset(1, -1).PasteSpecial Paste:=xlPasteValues


ElseIf Cells(i, 1) = "DEF" And Cells(i, 2) = "1" Then
    
    Sheets("Sheet4").Activate
    Rows("5:5").Select
    'Range("K5").Activate
    
    Selection.AutoFilter
    ActiveSheet.Range("$A$5:$M5").AutoFilter Field:=11, Criteria1:="<>"
    Range(Range("a6"), Cells(Rows.Count, "g").End(xlUp)).SpecialCells(xlVisible).Copy



    
    Sheets("Sheet5").Activate
    Cells(Rows.Count, 3).End(xlUp).Offset(1, -1).PasteSpecial Paste:=xlPasteValues


End If
 Next
End Sub

It does not do the select case anymore (It copies only new data only when ABC changes to "DEF" in my sheet.) I tired replacing it with "IF". Any Ideas how to make the loop to do the select case for each row separately?

 

[darekknox]

Topic can be closed. I added another

Sheets("Sheet1").Activate

After "For" statement