Refreshing a spreadsheet with macros

tjcusick

New Member
Joined
Mar 16, 2011
Messages
9
I have a spreadsheet with picked items on the First (original) page.
Name
B
C
D
E
F
G
H
I
Jane Doe
NM
SDS
AS
App
SM
CM
WK
6
John Doe
NM
Hou
AS
APP
SM
TUL
WK
6
Jack Doe
NM
SDS
CF
Tol
SM
TUL
WK
5

<tbody>
</tbody>


On the second page (Results)
Correct
NM
SDS
AS
APP
SM
TUL
WK

I would like to have a button to update the worksheet and show the correct results.

What I am wanting to do is, based on the "Correct" answers on the Second (results) Page, I want to Change the background color, in the cells, on the First(original) page, of the Incorrect answers and then in Column I, I want to report the Number of Incorrect answer.

I have tried to put formula's into Column I, but the only time they refresh is if I go into the actual cell and press enter. Also I cannot figure out how to do the Cell Highlighting in a macro instead of using the conditional formatting.

I would like to have this spreadsheet pretty much automated because it will be an ongoing project and all this manual manipulation is getting tedious.

Any and all suggestions will be greatly appreciated.

Thank you,

Tom Cusick
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Can we assume your answers are in Column "A" on Sheet(2) starting in row (1)

And the first name in Sheet(1) is on row (1)
 
Last edited:
Upvote 0
Can we assume your answers are in Column "A" on Sheet(2) starting in row (1)

And the first name in Sheet(1) is on row (1)

Actually the answers are in Column "A" on Sheet(2) starting in Row (2)

And the first Row in Sheet(1) is the Header Row, First Name starts on Sheet(1) Row(2)
 
Last edited:
Upvote 0
Try this:

Run this script from Sheet(1)

Code:
Sub Grades()
Application.ScreenUpdating = False
Dim i As Long
Dim b As Long
Dim Lastrow As Long
Dim Lastrowa As Long
Lastrow = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
Lastrowa = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row
Dim c As Range
    For i = 2 To Lastrow
        
        For b = 2 To Lastrowa
        
            If Cells(i, b).Value <> Sheets(2).Cells(b, 1).Value Then
            Cells(i, b).Interior.ColorIndex = 3
            Else
            Cells(i, Lastrowa + 1).Value = Cells(i, Lastrowa + 1).Value + 1
            End If
        Next
    
    Next
    
    
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Or if you want a Auto sheet event script which runs automatically when you change a cell value use this script:

The script assumes you have a list of values in Sheet (2) column "A" like previously mentioned.

This is an auto sheet event script
Your Workbook must be Macro enabled
To install this code:
Right-click on the sheet tab Sheet(1)
Select View Code from the pop-up context menu
Paste the code in the VBA edit window

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Lastrow As Long
Dim Lastrowa As Long
Application.ScreenUpdating = False
Lastrow = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
Lastrowa = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row
    If Not Intersect(Target, Range(Cells(2, "B"), Cells(Lastrow, Lastrowa))) Is Nothing Then
    If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
Range(Cells(2, Lastrowa + 1), Cells(Lastrow, Lastrowa + 1)).ClearContents
Dim i As Long
Dim b As Long
Dim c As Range
    For i = 2 To Lastrow
        
        For b = 2 To Lastrowa
        
            If Cells(i, b).Value <> Sheets(2).Cells(b, 1).Value Then
            Cells(i, b).Interior.ColorIndex = 3
            
            Else
            Cells(i, b).Interior.ColorIndex = 0
            Cells(i, Lastrowa + 1).Value = Cells(i, Lastrowa + 1).Value + 1
            
            End If
        Next
    
    Next
    
 End If
Application.ScreenUpdating = True
End Sub

OK
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,494
Messages
6,113,972
Members
448,537
Latest member
Et_Cetera

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