Excel 2013 VBA loop, how to make skip to next row

[jedwardo]

Hi Guys,

New at loops here, this is copying the data I need to a new sheet but it's all landing in the same two cells and overwriting the previous data instead of skipping to the next row down each time before pasting the next.

Sub TestSub()Dim iCell As Range
Lastrow = Sheet6.UsedRange.Rows.Count
For Each iCell In Range("A2:BD3")


If iCell.Interior.ColorIndex = 35 Then
Sheet6.Cells(Lastrow, 1).Value = iCell.Text
Sheet6.Cells(Lastrow, 1).Offset(0, 1).Value = iCell.Offset(0, 1).Text
End If


Next iCell


End Sub

 

[Michael M]

You need to repeat the last row line of code when the If statement has run

Sub TestSub()
Dim iCell As Range, ws As Worksheet
Set ws = Sheet6
Lastrow = ws.UsedRange.Rows.Count
    For Each iCell In Range("A2:BD3")
        If iCell.Interior.ColorIndex = 35 Then
            ws.Cells(Lastrow, 1).Value = iCell.Text
            ws.Cells(Lastrow, 1).Offset(0, 1).Value = iCell.Offset(0, 1).Text
        End If
    Lastrow = ws.UsedRange.Rows.Count
    Next iCell
End Sub

 

[jedwardo]

Thanks Michael, that's quite a bit cleaner than what I had going on. Still seems to be overwriting everything in the first 2 cells of sheet 6 though. It's going to pick up probably anywhere from 1 to 30 different cells with that color index within the if statement and it sticks them all in the first row on sheet 6

 

[Michael M]

Maybe your "lastRow" change is not impacting on Column "A"
Try this method... UNTESTED

Sub TestSub()
Dim iCell As Range, ws As Worksheet
Set ws = Sheet6
Lastrow = ws.Cells(Rows.Count, "A").End(xlUp).Row
    For Each iCell In Range("A2:BD3")
        If iCell.Interior.ColorIndex = 35 Then
            ws.Cells(Lastrow, 1).Value = iCell.value
            ws.Cells(Lastrow, 1).Offset(0, 1).Value = iCell.Offset(0, 1).value
        End If
        Lastrow = ws.Cells(Rows.Count, "A").End(xlUp).Row
    Next iCell
End Sub

 

[jedwardo]

Weird same thing. Thanks for troubleshooting with me, starting to drive me crazy

 

[Michael M]

Sub TestSub()
Dim iCell As Range, ws As Worksheet
Set ws = Sheet6
Lastrow = ws.Cells(Rows.Count, "A").End(xlUp).Row
    For Each iCell In Range("A2:BD3")
        If iCell.Interior.ColorIndex = 35 Then
            ws.Cells(Lastrow + 1, 1).Value = iCell.value
            ws.Cells(Lastrow + 1, 1).Offset(0, 1).Value = iCell.Offset(0, 1).value
        End If
        Lastrow = ws.Cells(Rows.Count, "A").End(xlUp).Row
    Next iCell
End Sub

 

[jedwardo]

Awesome, that was it. Thank you sir!!

 

[Michael M]

Whew....glad we got THAT sorted...

 

[Jerry Sullivan]

Since you are adding one row each time the color is found, consider this minor mod.
In addition to being more efficient, it will handle the possibility of blanks in Col A.

Sub TestSub()
Dim iCell As Range, ws As Worksheet
Set ws = Sheet6
Lastrow = ws.Cells(Rows.Count, "A").End(xlUp).Row
    For Each iCell In Range("A2:BD3")
        If iCell.Interior.ColorIndex = 35 Then
            ws.Cells(Lastrow + 1, 1).Value = iCell.value
            ws.Cells(Lastrow + 1, 1).Offset(0, 1).Value = iCell.Offset(0, 1).value
            [COLOR="#0000CD"]Lastrow=Lastrow+1
[/COLOR]        End If
    Next iCell
End Sub

 

[Michael M]

Hey Jerry....fair call there...One of my many failings, is assuming consistency...