Auto Colour based on answer key

B

bushidowarrior

Board Regular
Joined
Jun 27, 2011
Messages
84
Office Version
  1. 2019
Platform
  1. Windows
Hello All,

I have this table below. As you can see in the KEY column, is has the correct answer. In this case it is C.

Is there a was to make "WHAT" the correct answer highlight in GREEN?

And for the next row it would be D (They're)




i2amBDn.png



I would really appreciate it.

I have over 100 questions, hence I would like to automate this process a little.

Thank you.
 
Sort by date Sort by votes
bushidowarrior said:
Hello again, thank you once again.

I have been playing with the code and i would like to add one more thing please which I cannot seem to get working. I have added some other small things, but this one I cannot figure out.
Click to expand...

Ok, try this:

Code: 
[B][color=Royalblue]Sub[/color][/B] a1075737e()
[i][color=seagreen]'https://www.mrexcel.com/forum/excel-questions/1075737-auto-colour-based-answer-key.html[/color][/i]
[B][color=Royalblue]Dim[/color][/B]  r [B][color=Royalblue]As[/color][/B] Range, s  [B][color=Royalblue]As[/color][/B]  [B][color=Royalblue]String[/color][/B]
[B][color=Royalblue]Dim[/color][/B]  i [B][color=Royalblue]As[/color][/B]  [B][color=Royalblue]Long[/color][/B], j  [B][color=Royalblue]As[/color][/B] [B][color=Royalblue]Long[/color][/B],  x [B][color=Royalblue]As[/color][/B]  [B][color=Royalblue]Long[/color][/B], z  [B][color=Royalblue]As[/color][/B] [B][color=Royalblue]Long[/color][/B]
[B][color=Royalblue]Dim[/color][/B] va, vb, ac
Application.ScreenUpdating = [B][color=Royalblue]False[/color][/B]

Range([color=brown]"F3:I"[/color]  & Cells(Rows.count,  [color=brown]"E"[/color]).[B][color=Royalblue]End[/color][/B](xlUp).row).Interior.Color  = xlNone

[B][color=Royalblue]For[/color][/B]  [B][color=Royalblue]Each[/color][/B] r  [B][color=Royalblue]In[/color][/B] Range([color=brown]"E3"[/color],  Cells(Rows.count,  [color=brown]"E"[/color]).[B][color=Royalblue]End[/color][/B](xlUp))
    s = Trim(r)
     [B][color=Royalblue]If[/color][/B] s  [B][color=Royalblue]Like[/color][/B] [color=brown]"[A-D]"[/color]  [B][color=Royalblue]Then[/color][/B]
    x = r.row
        Range(s & x).Offset([color=crimson]0[/color], [color=crimson]5[/color]).Interior.Color = vbGreen
        va = Range(Cells(x, [color=brown]"F"[/color]), Cells(x, [color=brown]"I"[/color]))
         [B][color=Royalblue]ReDim[/color][/B] vb([color=crimson]1[/color]  [B][color=Royalblue]To[/color][/B] [color=crimson]1[/color],  [color=crimson]1[/color] [B][color=Royalblue]To[/color][/B] UBound(va,  [color=crimson]2[/color]))
        
        j = [color=crimson]2[/color]
         [B][color=Royalblue]For[/color][/B] i = [color=crimson]1[/color]  [B][color=Royalblue]To[/color][/B] UBound(vb, [color=crimson]2[/color])
        z = Range(s & [color=brown]"1"[/color]).Column
            [B][color=Royalblue]If[/color][/B] z = i [B][color=Royalblue]Then[/color][/B]
                vb([color=crimson]1[/color], [color=crimson]1[/color]) = va([color=crimson]1[/color], i)
                [B][color=Royalblue]Else[/color][/B]
                vb([color=crimson]1[/color], j) = va([color=crimson]1[/color], i)
                j = j + [color=crimson]1[/color]
            [B][color=Royalblue]End[/color][/B] [B][color=Royalblue]If[/color][/B]
        [B][color=Royalblue]Next[/color][/B]
        Range([color=brown]"K"[/color] & x) = Application.Index(vb, , [color=crimson]1[/color])
        Range([color=brown]"M"[/color] & x) = Application.Index(vb, , [color=crimson]2[/color])
        Range([color=brown]"O"[/color] & x) = Application.Index(vb, , [color=crimson]3[/color])
        Range([color=brown]"Q"[/color] & x) = Application.Index(vb, , [color=crimson]4[/color])
        
    [B][color=Royalblue]End[/color][/B] [B][color=Royalblue]If[/color][/B]
[B][color=Royalblue]Next[/color][/B]
Application.ScreenUpdating = [B][color=Royalblue]True[/color][/B]
[B][color=Royalblue]End[/color][/B] [B][color=Royalblue]Sub[/color][/B]


Excel 2007 32 bit
E​
F​
G​
H​
I​
J​
K​
L​
M​
N​
O​
P​
Q​
R​
2​
KEYABCD
1​
​
2​
​
3​
​
4​
​
3​
Bsgfgghfggsgfhf
4​
Dgdhhgd
5​
AGrfhyrGrfhyr
6​
Csdfrggfdffsdfrggdf
Sheet: Sheet2
 
Upvote 0

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Sorry, the above code is not efficient. Try this one instead:

Code: 
[B][COLOR=Royalblue]Sub[/COLOR][/B] a1075737f()
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1075737-auto-colour-based-answer-key.html[/COLOR][/I]
[B][COLOR=Royalblue]Dim[/COLOR][/B] r [B][COLOR=Royalblue]As[/COLOR][/B] Range, s [B][COLOR=Royalblue]As[/COLOR][/B] [B][COLOR=Royalblue]String[/COLOR][/B]
[B][COLOR=Royalblue]Dim[/COLOR][/B] i [B][COLOR=Royalblue]As[/COLOR][/B] [B][COLOR=Royalblue]Long[/COLOR][/B], j [B][COLOR=Royalblue]As[/COLOR][/B] [B][COLOR=Royalblue]Long[/COLOR][/B], x [B][COLOR=Royalblue]As[/COLOR][/B] [B][COLOR=Royalblue]Long[/COLOR][/B], z [B][COLOR=Royalblue]As[/COLOR][/B] [B][COLOR=Royalblue]Long[/COLOR][/B]
[B][COLOR=Royalblue]Dim[/COLOR][/B] va, vb, ac
Application.ScreenUpdating = [B][COLOR=Royalblue]False[/COLOR][/B]

Range([COLOR=brown]"F3:I"[/COLOR] & Cells(Rows.count, [COLOR=brown]"E"[/COLOR]).[B][COLOR=Royalblue]End[/COLOR][/B](xlUp).row).Interior.Color = xlNone
rr = Range([COLOR=brown]"E"[/COLOR] & Rows.count).[B][COLOR=Royalblue]End[/COLOR][/B](xlUp).row
[B][COLOR=Royalblue]ReDim[/COLOR][/B] vb([COLOR=crimson]1[/COLOR] [B][COLOR=Royalblue]To[/COLOR][/B] rr - [COLOR=crimson]2[/COLOR], [COLOR=crimson]1[/COLOR] [B][COLOR=Royalblue]To[/COLOR][/B] [COLOR=crimson]4[/COLOR])
[B][COLOR=Royalblue]For[/COLOR][/B] [B][COLOR=Royalblue]Each[/COLOR][/B] r [B][COLOR=Royalblue]In[/COLOR][/B] Range([COLOR=brown]"E3"[/COLOR], Cells(Rows.count, [COLOR=brown]"E"[/COLOR]).[B][COLOR=Royalblue]End[/COLOR][/B](xlUp))
    s = Trim(r)
    [B][COLOR=Royalblue]If[/COLOR][/B] s [B][COLOR=Royalblue]Like[/COLOR][/B] [COLOR=brown]"[A-D]"[/COLOR] [B][COLOR=Royalblue]Then[/COLOR][/B]
    x = r.row
        Range(s & x).Offset([COLOR=crimson]0[/COLOR], [COLOR=crimson]5[/COLOR]).Interior.Color = vbGreen
        va = Range(Cells(x, [COLOR=brown]"F"[/COLOR]), Cells(x, [COLOR=brown]"I"[/COLOR]))
        
        j = [COLOR=crimson]2[/COLOR]
        [B][COLOR=Royalblue]For[/COLOR][/B] i = [COLOR=crimson]1[/COLOR] [B][COLOR=Royalblue]To[/COLOR][/B] UBound(vb, [COLOR=crimson]2[/COLOR])
        z = Range(s & [COLOR=brown]"1"[/COLOR]).Column
            [B][COLOR=Royalblue]If[/COLOR][/B] z = i [B][COLOR=Royalblue]Then[/COLOR][/B]
                vb(x - [COLOR=crimson]2[/COLOR], [COLOR=crimson]1[/COLOR]) = va([COLOR=crimson]1[/COLOR], i)
                [B][COLOR=Royalblue]Else[/COLOR][/B]
                vb(x - [COLOR=crimson]2[/COLOR], j) = va([COLOR=crimson]1[/COLOR], i)
                j = j + [COLOR=crimson]1[/COLOR]
            [B][COLOR=Royalblue]End[/COLOR][/B] [B][COLOR=Royalblue]If[/COLOR][/B]
        [B][COLOR=Royalblue]Next[/COLOR][/B]
        
    [B][COLOR=Royalblue]End[/COLOR][/B] [B][COLOR=Royalblue]If[/COLOR][/B]
[B][COLOR=Royalblue]Next[/COLOR][/B]
        Range([COLOR=brown]"K3:K"[/COLOR] & x) = Application.Index(vb, , [COLOR=crimson]1[/COLOR])
        Range([COLOR=brown]"M3:M"[/COLOR] & x) = Application.Index(vb, , [COLOR=crimson]2[/COLOR])
        Range([COLOR=brown]"O3:O"[/COLOR] & x) = Application.Index(vb, , [COLOR=crimson]3[/COLOR])
        Range([COLOR=brown]"Q3:Q"[/COLOR] & x) = Application.Index(vb, , [COLOR=crimson]4[/COLOR])

Application.ScreenUpdating = [B][COLOR=Royalblue]True[/COLOR][/B]
[B][COLOR=Royalblue]End[/COLOR][/B] [B][COLOR=Royalblue]Sub[/COLOR][/B]
 
Upvote 0
Excellent, thank you very much!!!!!!!!!!

Akuini said:
Sorry, the above code is not efficient. Try this one instead:

Code: 
[B][COLOR=Royalblue]Sub[/COLOR][/B] a1075737f()
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1075737-auto-colour-based-answer-key.html[/COLOR][/I]
[B][COLOR=Royalblue]Dim[/COLOR][/B] r [B][COLOR=Royalblue]As[/COLOR][/B] Range, s [B][COLOR=Royalblue]As[/COLOR][/B] [B][COLOR=Royalblue]String[/COLOR][/B]
[B][COLOR=Royalblue]Dim[/COLOR][/B] i [B][COLOR=Royalblue]As[/COLOR][/B] [B][COLOR=Royalblue]Long[/COLOR][/B], j [B][COLOR=Royalblue]As[/COLOR][/B] [B][COLOR=Royalblue]Long[/COLOR][/B], x [B][COLOR=Royalblue]As[/COLOR][/B] [B][COLOR=Royalblue]Long[/COLOR][/B], z [B][COLOR=Royalblue]As[/COLOR][/B] [B][COLOR=Royalblue]Long[/COLOR][/B]
[B][COLOR=Royalblue]Dim[/COLOR][/B] va, vb, ac
Application.ScreenUpdating = [B][COLOR=Royalblue]False[/COLOR][/B]

Range([COLOR=brown]"F3:I"[/COLOR] & Cells(Rows.count, [COLOR=brown]"E"[/COLOR]).[B][COLOR=Royalblue]End[/COLOR][/B](xlUp).row).Interior.Color = xlNone
rr = Range([COLOR=brown]"E"[/COLOR] & Rows.count).[B][COLOR=Royalblue]End[/COLOR][/B](xlUp).row
[B][COLOR=Royalblue]ReDim[/COLOR][/B] vb([COLOR=crimson]1[/COLOR] [B][COLOR=Royalblue]To[/COLOR][/B] rr - [COLOR=crimson]2[/COLOR], [COLOR=crimson]1[/COLOR] [B][COLOR=Royalblue]To[/COLOR][/B] [COLOR=crimson]4[/COLOR])
[B][COLOR=Royalblue]For[/COLOR][/B] [B][COLOR=Royalblue]Each[/COLOR][/B] r [B][COLOR=Royalblue]In[/COLOR][/B] Range([COLOR=brown]"E3"[/COLOR], Cells(Rows.count, [COLOR=brown]"E"[/COLOR]).[B][COLOR=Royalblue]End[/COLOR][/B](xlUp))
    s = Trim(r)
    [B][COLOR=Royalblue]If[/COLOR][/B] s [B][COLOR=Royalblue]Like[/COLOR][/B] [COLOR=brown]"[A-D]"[/COLOR] [B][COLOR=Royalblue]Then[/COLOR][/B]
    x = r.row
        Range(s & x).Offset([COLOR=crimson]0[/COLOR], [COLOR=crimson]5[/COLOR]).Interior.Color = vbGreen
        va = Range(Cells(x, [COLOR=brown]"F"[/COLOR]), Cells(x, [COLOR=brown]"I"[/COLOR]))
        
        j = [COLOR=crimson]2[/COLOR]
        [B][COLOR=Royalblue]For[/COLOR][/B] i = [COLOR=crimson]1[/COLOR] [B][COLOR=Royalblue]To[/COLOR][/B] UBound(vb, [COLOR=crimson]2[/COLOR])
        z = Range(s & [COLOR=brown]"1"[/COLOR]).Column
            [B][COLOR=Royalblue]If[/COLOR][/B] z = i [B][COLOR=Royalblue]Then[/COLOR][/B]
                vb(x - [COLOR=crimson]2[/COLOR], [COLOR=crimson]1[/COLOR]) = va([COLOR=crimson]1[/COLOR], i)
                [B][COLOR=Royalblue]Else[/COLOR][/B]
                vb(x - [COLOR=crimson]2[/COLOR], j) = va([COLOR=crimson]1[/COLOR], i)
                j = j + [COLOR=crimson]1[/COLOR]
            [B][COLOR=Royalblue]End[/COLOR][/B] [B][COLOR=Royalblue]If[/COLOR][/B]
        [B][COLOR=Royalblue]Next[/COLOR][/B]
        
    [B][COLOR=Royalblue]End[/COLOR][/B] [B][COLOR=Royalblue]If[/COLOR][/B]
[B][COLOR=Royalblue]Next[/COLOR][/B]
        Range([COLOR=brown]"K3:K"[/COLOR] & x) = Application.Index(vb, , [COLOR=crimson]1[/COLOR])
        Range([COLOR=brown]"M3:M"[/COLOR] & x) = Application.Index(vb, , [COLOR=crimson]2[/COLOR])
        Range([COLOR=brown]"O3:O"[/COLOR] & x) = Application.Index(vb, , [COLOR=crimson]3[/COLOR])
        Range([COLOR=brown]"Q3:Q"[/COLOR] & x) = Application.Index(vb, , [COLOR=crimson]4[/COLOR])

Application.ScreenUpdating = [B][COLOR=Royalblue]True[/COLOR][/B]
[B][COLOR=Royalblue]End[/COLOR][/B] [B][COLOR=Royalblue]Sub[/COLOR][/B]
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question
conditional formatting a cell when it is within a certain time bracket
Replies
5
Views
137
Mr Marvin
M
A
  • Question
VBA to change cell colour based on content
Replies
3
Views
166
Snakehips
Snakehips
T
  • Question
Compare spreadsheet/worksheet with changing rows
Replies
2
Views
83
BenW71
B
JulieBunavicz
  • Question
Automating Duplicate Check
Replies
5
Views
462
JulieBunavicz
JulieBunavicz
O
  • Solved
mod(row() change font colour as required
Replies
7
Views
242
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,214,948
Messages
6,122,420
Members
449,083
Latest member
Ava19

Share this page

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