Displaying rows having one cell font color to different sheet.

[jlokesh16]

Hello,

I have 4 columns in sheet 1, in which the first column has cells whose font color is red.
I want to copy only those rows whose first column cell data has red font color to sheet 2.

 

[jlokesh16]

I am currently using red as vbred, so for blue and green, can we use vbgreen for green and vgblue for blue

 

[Peter_SSs]

I am currently using red as vbred, so for blue and green, can we use vbgreen for green and vgblue for blue

You can use them but it will only work if those are the exact colours that you have formatted the font in column A with.

.. and you didn't answer about what sheet each of those colours should get copied to.

 

[jlokesh16]

as the red is getting copied to Sheet2, Green should get copied to Sheet3 & Blue should get copied to Sheet4.
I want to have this in single macro.

Below is the VBA i am using for highlighting red color.
Can you help me out in adding the highlight of green and blue in this code itself and then exporting those to respective sheets if we create sheet name "Red" for red, "Blue" to blue and "Green" to green.

Sub CompareAndHighlight()


    Dim rng1 As Range, rng2 As Range, i As Long, j As Long
    For i = 1 To Sheets("Input Data").Range("B" & Rows.Count).End(xlUp).Row
        Set rng1 = Sheets("Input Data").Range("B" & i)
        For j = 1 To Sheets("Priority Apt Code").Range("C" & Rows.Count).End(xlUp).Row
            Set rng2 = Sheets("Priority Apt Code").Range("C" & j)
            If StrComp(Trim(rng1.Text), Trim(rng2.Text), vbTextCompare) = 0 Then
                rng1.Font.Color = vbRed
            End If
            Set rng2 = Nothing
        Next j
        Set rng1 = Nothing
    Next i


End Sub

 

[Peter_SSs]

When posting code, please use Code Tags to preserve the indentation as it makes the code much easier to read, debug and copy/paste to test with. My signature block below explains how. I have added tags to your last post.

Can you help me out in adding the highlight of green and blue in this code itself ..

I'm afraid not as there appears to be no information about how to determine what gets coloured red, what blue and what green.

.. exporting those to respective sheets if we create sheet name "Red" for red, "Blue" to blue and "Green" to green.

That could be achieved with something like this.

Sub MoveColours()
  Dim ColourMapping As Variant
  Dim i As Long
  
  ColourMapping = Array(vbRed, "Sheet2", vbBlue, "Sheet3", vbGreen, "Sheet4")
  For i = LBound(ColourMapping) To UBound(ColourMapping) Step 2
    With Sheets("Sheet1").UsedRange
      .AutoFilter Field:=1, Criteria1:=ColourMapping(i), Operator:=xlFilterFontColor
      .Copy Destination:=Sheets(ColourMapping(i + 1)).Range("A1")
      .AutoFilter
    End With
  Next i
End Sub

 

[jlokesh16]

I have a sheet where the to be highlighted list is present.
With the above code, can i just run the macro and it will change the font color in red, blue green and export it to assigned sheets?

 

[Peter_SSs]

I have a sheet where the to be highlighted list is present.

Perhaps you have, but you haven't shown it or described it to us. Too hard to try to work out what you have, where and what it means by reading code.

BTW, if you have a list of things to be coloured and then use the colours to move to other sheets, why not skip the colouring and just use the list directly to move things to the other sheets?

With the above code, can i just run the macro and it will change the font color in red, blue green and export it to assigned sheets?

Simplest way to answer that would be to try it.

 

[jlokesh16]

I will explain my requirements in simple form.
In Sheet 1 i have a master list which has data in from Col A to Col D. The only col i want to highlight is col A.
In Sheet 2, col A has list which needs to be highlighted in red, Col B has list which needs to be highlighted in Green, & Col C has list of blue in Sheet 1 Col A.
Here i want to highlight all the entities from Sheet 2 Col A in red to Sheet 1 col A, Sheet 2 col B in Green to sheet 1 col A & sheet 2 Col C to Sheet 1 col A.
After highlighting is done, it should auto extract the red highlighted data (all data in Row) to respective color name sheets.

 

[Peter_SSs]

Can you have Sheet2 set up like below with
- The destination sheet name in row 1
- The heading from Sheet1, column A in each cell in row 2
- The data to determine colour below that

Book1
	A	B	C
1	Red	Green	Blue
2	Apt name	Apt name	Apt name
3	ACH10P01	data 3	data 4
4	data 1	data 5
5	data 2
6	data 6
7	data 7
8	data 8
9
Sheet2

Then run this code

Sub ColourAndMove()
  Dim ws2 As Worksheet
  Dim i As Long, OrigCol As Long
  Dim aColors As Variant
  Dim rCrit As Range
  
  aColors = Array(vbRed, vbGreen, vbBlue)
  Set ws2 = Sheets("Sheet2")
  With Sheets("Sheet1")
    OrigCol = .Range("A1").Font.Color
    For i = 1 To 3
      Set rCrit = ws2.Range(ws2.Cells(2, i), ws2.Cells(ws2.Rows.Count, i).End(xlUp))
      With .Range("A1", .Range("A" & .Rows.Count).End(xlUp)).Resize(, 4)
        .AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=rCrit, Unique:=False
        .Columns(1).SpecialCells(xlVisible).Font.Color = aColors(LBound(aColors) + i - 1)
        .Range("A1").Font.Color = OrigCol
        .Copy Destination:=Sheets(ws2.Cells(1, i).Value).Range("A1")
      End With
      If .FilterMode Then .ShowAllData
    Next i
  End With
End Sub

My Sheet1 after running the code

Book1
	A	B	C	D
1	Apt name	Calls	start time	end time
2	ACH10P01	2	8/15/2018 11:51:49 AM	8/15/2018 12:23:53 PM
3	ALD10P01	8	8/15/18 12:36 PM	8/15/18 9:27 PM
4	data 1	2	Start time 3	End time 3
5	data 2	6	Start time 4	End time 4
6	data 3	5	Start time 5	End time 5
7	data 4	3	Start time 6	End time 6
8	data 5	2	Start time 7	End time 7
9	data 6	3	Start time 8	End time 8
10	data 7	1	Start time 9	End time 9
11	data 8	2	Start time 10	End time 10
12
Sheet1

 

[jlokesh16]

Getting an error " Run-Time error '1004', This can't be applied to the selected range. Select a single cell in a range and try again"

 

[Peter_SSs]

Getting an error " Run-Time error '1004', This can't be applied to the selected range. Select a single cell in a range and try again"

1. Which line in the code is giving that error.

2. Have you modified the code at all?

3. Are you testing with the sample data and layout I posted? If not, can you try it with that data/layout in a fresh workbook as it worked for me in that configuration. If that works for you then we have to try to work out what is different about the real data/workbook.

4. What version of Excel are you using and what operating system?