Values-specific coloured cells to retain its colour

Joined
May 20, 2021
Messages
26
Office Version
  1. 2016
Platform
  1. Windows
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)
 
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.
 
Upvote 0

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
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.
 

Attachments

  • BCEBBEC8-215E-498C-A1B9-8B4578B380FB.jpeg
    BCEBBEC8-215E-498C-A1B9-8B4578B380FB.jpeg
    211.1 KB · Views: 12
  • 3E39286C-E9D7-4EB3-A9B8-FBDE74AF0187.jpeg
    3E39286C-E9D7-4EB3-A9B8-FBDE74AF0187.jpeg
    141.4 KB · Views: 12
Upvote 0
Oh right, this is what the latest code that you’ve given does.
 

Attachments

  • 349B867F-BFBC-4B6D-8A6C-0796A61EA169.jpeg
    349B867F-BFBC-4B6D-8A6C-0796A61EA169.jpeg
    223.6 KB · Views: 10
Upvote 0
VBA Code:
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.
 
Upvote 0
If you want to just compare same header columns, maybe like this.
Code:
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
 
Upvote 0
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.
Code:
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
 
Upvote 0
Solution
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.
 
Upvote 0
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.
 
Upvote 0
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!
 
Upvote 0

Forum statistics

Threads
1,213,515
Messages
6,114,080
Members
448,548
Latest member
harryls

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top