CODEWITHSUNDEEP
excelvba
user3522636
user3522636

Reputation: 3

Copying specific coloured cells onto a different worksheet

I'm working on a spreadsheet with conditional formatting, which turns some cells green and some red, depending on if they are in/out of the correct range.

What I need is for the red "out of spec" numbers to be copied onto the next sheet leaving the green "within spec" number off the second sheet. A bit like this:

Sheet 1:

a 2

b 4

c 5

d 6

e 3

Sheet 2:

a

b 4

c 5

d 6

e

I hope this makes sense, I did take screenshots but I can't post them! My fingers are crossed that someone can help :)

Thank you in advance Jazz

Upvotes: 0

Views: 5896

Answers (2)

Hubvill
Hubvill

Reputation: 504

This is probably not the best way to do it but, it worked for me.
Try:

Dim i As Integer
Dim cell As String

Sheets("Sheet1").Activate

For i = 1 To 10

    'Check if font is red
    If Range("A" & i).Font.Color = "fontcolor" Then

    cell = Range("A" & i).Value
    'Check for a number in the cell and remove the right most number
    While IsNumeric(Right(cell, 1))
        cell = Range("A" & i).Value
        cell = Left(cell, Len(cell) - 1)
        Sheets("sheet2").Range("A" & i).Value = cell
    Wend

    Else
    'If font is not red then display cell value on sheet2
    Sheets("sheet2").Range("A" & i).Value = Sheets("sheet1").Range("A" & i).Value
    End If

Next

Sheets("Sheet2").Activate

Edited
In this case "A3" has red font.
To find the color of your red font use:

sub Text_Color()
Dim color As String
'"A3" has red text.
color = Sheets("sheet1").Range("A3").Font.color
MsgBox "My text color is= " & color
End Sub

Take the number found in the msgbox, in this example 393372. And replace "fontcolor" from the above code with 393372 .

Upvotes: 0

in_user
in_user

Reputation: 1958

I have assumed that data is in Column A of Sheet1.

Tested

Sub checkColornCopy()

Find the last row for automation

lastRow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

sheet2Counter = 1

For i = 1 To lastRow

Extracting the color of the Cell interior

ConditionalColor = Worksheets("Sheet1").Cells(i, 1).Interior.ColorIndex

Color Index 3 denotes "Red" 

If ConditionalColor = 3 Then

If the color is Red thenCopying the cell content of Sheet1 to Sheet2

Worksheets("Sheet2").Cells(sheet2Counter, 1).Value = Worksheets("Sheet1").Cells(i, 1).Value

Making the cell content of Sheet1 blank

Worksheets("Sheet1").Cells(i, 1).Value = " "
sheet2Counter = sheet2Counter + 1

End If

Next

End Sub

Upvotes: 1

Related Questions