Values-specific coloured cells to retain its colour

[XanderTheNotSoAwesome]

Sheet 1: Has values like 33.878 in Yellow, 17.873 in Red and 96.666 in Green.

Is there a way to ensure that these coloured cells are carried over to sheet 2? (Sheet 2 has a macro that sorts out the scores according to percentile and other considerations so I can’t just copy&paste/use simple filtering or sorting and was wondering if there is a code to bring the colours-specific to its value over instead of manually colouring them)

 

[jolivanes]

Which columns need to be compared?
If you compare numbers that were calculated, you have a very good chance that they appear to be the same but are not (3.45 vs 3.4512) because of decimals showing/not showing.
The codes in Posts 6 and 9 look for same values and then use the background color of found value to color the cell value.
Obviously there is more to it.

 

[XanderTheNotSoAwesome]

Have uploaded an example of how both sheets should look like. The only thing I can’t do is replicate the colours for sheet 2. It remains uncoloured.

I have checked the values and they are all accurate even to the 8th decimal place, there are no changes to the value in both sheets.

 

[XanderTheNotSoAwesome]

Oh right, this is what the latest code that you’ve given does.

 

[jolivanes]

Sub Try_This_Way()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim lr1 As Long, lr2 As Long
Dim rng1 As Range, rng2 As Range
Dim c As Range, cel As Range
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
lr1 = sh1.Cells(Rows.Count, 5).End(xlUp).Row
lr2 = sh2.Cells(Rows.Count, 3).End(xlUp).Row
Set rng1 = sh1.Range("E2:F" & lr1 & "," & "H2:H" & lr1)
Set rng2 = sh2.Range("C2:E" & lr2)
rng2.Interior.Color = xlNone
    For Each c In rng2
        For Each cel In rng1
            If cel.Value = c.Value Then
                c.Interior.Color = cel.Interior.Color
                Exit For
            End If
        Next cel
    Next c
End Sub

Check all references, ranges, sheets and whatever. Change if required.

 

[jolivanes]

If you want to just compare same header columns, maybe like this.

Sub Per_Individual_Column()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim colSht1, colSht2
Dim lr1 As Long, lr2 As Long
Dim i As Long, c As Range
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
lr1 = sh1.Cells(Rows.Count, 5).End(xlUp).Row
lr2 = sh2.Cells(Rows.Count, 3).End(xlUp).Row
colSht1 = Array(5, 6, 8)
colSht2 = Array(3, 4, 5)
    For i = LBound(colSht2) To UBound(colSht2)
        For Each c In sh2.Cells(2, colSht2(i)).Resize(lr2 - 1)
        If WorksheetFunction.CountIf(sh1.Cells(2, colSht1(i)).Resize(lr1 - 1), c.Value) <> 0 Then
            c.Interior.Color = sh1.Cells(2, colSht1(i)).Resize(lr1 - 1).Find(c, , , 1).Interior.Color
        End If
        Next c
    Next i
End Sub

 

[jolivanes]

If you want to mix-up your columns, headers in different columns, use this.
It has no Column amount restriction as long as there are headers in Row 1. It uses the same headers in both sheets.
Sheet1 subject headers need to start in Column E and continue to the right while in Sheet2 this needs to be Column C.
If that changes, code needs to be changed to reflect this.

Sub With_Header_Array()
Dim subjCol, i As Long, c As Range
Dim sh1Col As Long, sh2Col As Long
Dim sh1 As Worksheet, sh2 As Worksheet
Dim lr1 As Long, lr2 As Long
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
lr1 = sh1.Cells(Rows.Count, 5).End(xlUp).Row    '<---- Sheet1, Column 5 (Column E)
lr2 = sh2.Cells(Rows.Count, 3).End(xlUp).Row    '<---- Sheet2, Column 3 (Column C)
subjCol = Application.Transpose(sh2.Cells(1, 3).Resize(, sh2.Cells(1, sh2.Columns.Count).End(xlToLeft).Column - 2).Value)    '<---- Sheet2, Column 3 (Column C)
    For i = LBound(subjCol) To UBound(subjCol)
        If WorksheetFunction.CountIf(sh1.Rows(1), subjCol(i, 1)) <> 0 Then
            sh1Col = sh1.Rows(1).Find(subjCol(i, 1)).Column
            sh2Col = sh2.Rows(1).Find(subjCol(i, 1)).Column
                For Each c In sh2.Cells(2, sh2Col).Resize(lr2 - 1)
                    If WorksheetFunction.CountIf(sh1.Cells(2, sh1Col).Resize(lr1 - 1), c.Value) <> 0 Then
                        c.Interior.Color = sh1.Cells(2, sh1Col).Resize(lr1 - 1).Find(c, , , 1).Interior.Color
                    End If
                Next c
        End If
    Next i
End Sub

 

[jolivanes]

Fill cell colour according to percentile.

I have an excel sheet of students with their different subject scores for their tests. Row: Student Names Columns: Subject headers and their scores. (Math, Science, Literature. Is there a excel macro that can automatically help me colour the cells of those in the top 20% green, next 20% light...

www.mrexcel.com

In the above thread you indicate that the numbers are calculated as a percentage.
Does this still keep the values to be compared exactly the same? any difference at all and the code does not give a proper result.

 

[XanderTheNotSoAwesome]

Sorry for the late response, was down with sickness..

For your question on percentile, I thought they were initially colour coded based on percentile but that’s not the case.

The process is like this:

1. I receive Sheet 1 as it is, coloured from the Test Department after they have calculated the scores. They don’t tell me what’s the criteria for the colours, I’m just supposed to run a few macros and reach Sheet 2. (The scores don’t change, I just have to rank the students)

2. Previously, I went to colour every single cell myself, one monitor showing sheet 1 and another showing sheet 2.

That obviously created a lot of problems, first is human error and second is that if there are 200-300 students for that batch I’m basically spending a full shift at work just colouring cells which is extremely inefficient. I was told if I could come up with a macro that could automatically colour the cells, I could feel free to, but I couldn’t do it cuz I’m quite an amateur at this.

I requested help from the Test Department but they told me they couldn’t disclose the macro to me due to confidentiality issues, thus I have to be really vague here, I’m sorry if it’s frustrating to you and I understand how frustrating it can be.

 

[XanderTheNotSoAwesome]

Will give those help above a try and let you know how it goes — and as usual, thank you so much for going out of your way to help!

 

[XanderTheNotSoAwesome]

Thanks for helping out with the codes! I managed to get it settled! Much appreciated. You are awesome