Loop if cell is red, insert into other sheet help

  • Hi all,


    I'm just getting started on a small project. I have a workbook that I need to write some code to do the following: When ran, it will go through several worksheets and if cell is red in column D, it will then insert that value in a list on a seperate worksheet.


    Has anyone done something close to this? I'm having some trouble understanding how to loop it for each worksheet, and how to transfer the value over to another worksheet if there is a match. I'm still gathering code, so i do not have much useful to post just yet. Thanks for any help in getting me started.

  • Re: Loop if cell is red, insert into other sheet help


    Hi Hueby,


    Try this: Change the references accordingly. this code places the values in a sheet called Summary. Please change to suit to your requirements.


    [vba]
    Sub test()
    Dim ws As Worksheet
    Dim cell As Range


    For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Summary" Then
    For Each cell In Range(ws.Range("D1"), ws.Range("D65536").End(xlUp))
    If cell.Interior.ColorIndex = 3 Then
    cell.Copy Destination:=Sheets("Summary").Range("A65536").End(xlUp).Offset(1, 0)
    End If
    Next
    End If
    Next
    End Sub
    [/vba]


    HTH

  • Re: Loop if cell is red, insert into other sheet help


    Ahh! Thank you very much, this provides some code I was missing/having trouble on. :rock:

  • Re: Loop if cell is red, insert into other sheet help


    How simple is it to grab the values from Column A, and B too when it finds a match in D - and transfer them over?

  • Re: Loop if cell is red, insert into other sheet help


    Hi Hueby,


    Try this. This will copy values in Col A,B to Col A, Col B of Summary sheet if the cell is colored red in Col D. It is also to simple to copy the entire row to a different sheet from this.


    [vba]
    cell.EntireRow.Copy Destination:=Sheets("Summary").Range("A65536").End(xlUp).Offset(1, 0)
    [/vba]



    [vba]
    Sub test()
    Dim ws As Worksheet
    Dim cell As Range

    For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Summary" Then
    For Each cell In Range(ws.Range("D1"), ws.Range("D65536").End(xlUp))
    If cell.Interior.ColorIndex = 3 Then
    cell.Offset(0, -3).Copy Destination:=Sheets("Summary").Range("A65536").End(xlUp).Offset(1, 0)
    cell.Offset(0, -2).Copy Destination:=Sheets("Summary").Range("B65536").End(xlUp).Offset(1, 0)
    cell.Copy Destination:=Sheets("Summary").Range("D65536").End(xlUp).Offset(1, 0)
    End If
    Next
    End If
    Next
    End Sub
    [/vba]

Participate now!

Don’t have an account yet? Register yourself now and be a part of our community!