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
[Table="width:, class:head"][tr=bgcolor:#008B8B][th] [/th][th]
E​
[/th][th]
F​
[/th][th]
G​
[/th][th]
H​
[/th][th]
I​
[/th][th]
J​
[/th][th]
K​
[/th][th]
L​
[/th][th]
M​
[/th][th]
N​
[/th][th]
O​
[/th][th]
P​
[/th][th]
Q​
[/th][th]
R​
[/th][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
2​
[/td][td=bgcolor:#FFFF00]KEY[/td][td=bgcolor:#FFFF00]A[/td][td=bgcolor:#FFFF00]B[/td][td=bgcolor:#FFFF00]C[/td][td=bgcolor:#FFFF00]D[/td][td=bgcolor:#FFFF00][/td][td=bgcolor:#FFFF00]
1​
[/td][td=bgcolor:#FFFF00]
​
[/td][td=bgcolor:#FFFF00]
2​
[/td][td=bgcolor:#FFFF00]
​
[/td][td=bgcolor:#FFFF00]
3​
[/td][td=bgcolor:#FFFF00]
​
[/td][td=bgcolor:#FFFF00]
4​
[/td][td=bgcolor:#FFFF00]
​
[/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
3​
[/td][td=bgcolor:#FFFFFF]B[/td][td]sgf[/td][td=bgcolor:#00FF00]gg[/td][td]h[/td][td]f[/td][td=bgcolor:#FFFFFF][/td][td=bgcolor:#FFFFFF]gg[/td][td=bgcolor:#FFFFFF][/td][td=bgcolor:#FFFFFF]sgf[/td][td=bgcolor:#FFFFFF][/td][td]h[/td][td][/td][td]f[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
4​
[/td][td=bgcolor:#FFFFFF]D[/td][td]g[/td][td][/td][td]d[/td][td=bgcolor:#00FF00]h[/td][td=bgcolor:#FFFFFF][/td][td=bgcolor:#FFFFFF]h[/td][td=bgcolor:#FFFFFF][/td][td=bgcolor:#FFFFFF]g[/td][td=bgcolor:#FFFFFF][/td][td][/td][td][/td][td]d[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
5​
[/td][td=bgcolor:#FFFFFF]A[/td][td=bgcolor:#00FF00]G[/td][td]rf[/td][td]hy[/td][td]r[/td][td=bgcolor:#FFFFFF][/td][td=bgcolor:#FFFFFF]G[/td][td=bgcolor:#FFFFFF][/td][td=bgcolor:#FFFFFF]rf[/td][td=bgcolor:#FFFFFF][/td][td]hy[/td][td][/td][td]r[/td][td][/td][/tr]

[tr=bgcolor:#FFFFFF][td=bgcolor:#008B8B]
6​
[/td][td=bgcolor:#FFFFFF]C[/td][td]sdfr[/td][td]gg[/td][td=bgcolor:#00FF00]f[/td][td]df[/td][td=bgcolor:#FFFFFF][/td][td=bgcolor:#FFFFFF]f[/td][td=bgcolor:#FFFFFF][/td][td=bgcolor:#FFFFFF]sdfr[/td][td=bgcolor:#FFFFFF][/td][td]gg[/td][td][/td][td]df[/td][td][/td][/tr]
[/table][Table="width:, class:grid"][tr][td]Sheet: Sheet2[/td][/tr][/table]
 
Upvote 0

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
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

P
  • Question Question
TypeScript (or other solutions) for modifying given list of cells (and similar problems)
Replies
0
Views
284
Pingaware
P
K
  • Solved
Undo Stack gets cleared running VBA - Possible Solution to fix this?
Replies
5
Views
165
kellman
K
A
  • Solved
Automate data export from multiple word tables into excel
Replies
8
Views
234
NdNoviceHlp
NdNoviceHlp
E
  • Question Question
Index with match and (maybe) offset?
2
Replies
10
Views
218
Peter_SSs
Peter_SSs
S
  • Question Question
Help with conditional formatting using a pivot table with dynamic ranges
Replies
1
Views
125
RoryA
RoryA

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

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