Wonder if this is possible... if so, how?

[bomberman411]

Hello all,

I have 2 worksheets (tabs) in my excel. In the first one I have some of the lines in red (font color). The second tab I have is filled only with the informations that is in red on the first tab.

Is there a way for me to make a macro that would scan my first tab info and if it finds text in red (font , not background), it copies the whole row of information (column A to H inclusively) to my second tab...

I know I'm not to clear in my description, but is this possible?

 

[VoG]

Try

Sub test()
Dim LR As Long, i As Long, j As Long
With Sheets("Sheet1")
    LR = .Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To LR
        If .Range("A" & i).Font.ColorIndex = 3 Then
            j = j + 1
            .Range("A" & i & ":H" & i).Copy Destination:=Sheets("Sheet2").Range("A" & j)
        End If
    Next i
End With
End Sub

 

[bomberman411]

Hello Vog,

Thanks for you reply.

Your code works, but I forgot to mention a few things:

- Sheet2 needs to be cleared of all information starting at cell A8 going downwards and to the right (to H8 inclusively)

- Sheet2 needs to start at cell "A8"

- Sheet2 doesn't have to have all the text in red, so is there a way to change the text color back to black while copying/transfering?

 

[VoG]

Try

Sub test()
Dim LR1 As Long, LR2 As Long, i As Long, j As Long
With Sheets("Sheet2")
    LR2 = .Range("A" & Rows.Count).End(xlUp).Row
    .Range("A8:H" & LR2).ClearContents
End With
j = 7
With Sheets("Sheet1")
    LR1 = .Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To LR1
        If .Range("A" & i).Font.ColorIndex = 3 Then
            j = j + 1
            .Range("A" & i & ":H" & i).Copy
            Sheets("Sheet2").Range("A" & j).PasteSpecial Paste:=xlPasteValues
        End If
    Next i
End With
End Sub

 

[bomberman411]

Superb, thank you very much! I works.

Only problem now is that the code makes Excel switch from on tab to another every second... can someone say SEISURE? :P

 

[VoG]

Only problem now is that the code makes Excel switch from on tab to another every second... can someone say SEISURE? :P

Is there worksheet code with those sheets? My code doesn't switch tabs at all.

 

[bomberman411]

Superb, thank you very much! I works.

Only problem now is that the code makes Excel switch from on tab to another every second... can someone say SEISURE? :P

Actually, it only did the switching thing once, the first time... hasn't done it again so far. thanks!

If i'm on sheet2 when I start the code, it does it, but not if I start the macro while on sheet1... anyway, it's really not a problem.

 

[bomberman411]

Ha! I can't even duplicate the tab-switching experience... it only did it once, hasn't done it since, so NVM :P

 

[bomberman411]

One last thing though:

When the code clears the data on Sheet2, it clears 1 row to many, the A7 row (which is a header row).

 

[VoG]

Perhaps

Sub test()
Dim LR1 As Long, LR2 As Long, i As Long, j As Long
With Sheets("Sheet2")
    LR2 = .Range("A" & Rows.Count).End(xlUp).Row
    If LR2 > 7 Then .Range("A8:H" & LR2).ClearContents
End With
j = 7
With Sheets("Sheet1")
    LR1 = .Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To LR1
        If .Range("A" & i).Font.ColorIndex = 3 Then
            j = j + 1
            .Range("A" & i & ":H" & i).Copy
            Sheets("Sheet2").Range("A" & j).PasteSpecial Paste:=xlPasteValues
        End If
    Next i
End With
End Sub