Forum Discussion
Automatically replace old data with new data
Hello. I am trying to create a sheet that averages the last 5 scores. My idea is to have the input cell at A1, and the average cell at A7. When a value is entered into A1, it appears in A2. Wh...
Joshua_Brewerton VBA can be used to automate what you've described. Right-click on the worksheet tab and select "View Code", then paste the following code into the worksheet module:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'Stop the macro if more than one cell was changed
If Target.Cells.Count > 1 Then Exit Sub
'Verify the input cell was changed and is not blank
Dim rg As Range: Set rg = Me.Range("A1")
If Not Intersect(Target, rg) Is Nothing And rg.Value <> "" Then
' validate the new score
If Not Application.WorksheetFunction.IsNumber(rg.Value) Then
' display validation error
MsgBox "Please enter numeric values only", vbCritical, "Invalid Score"
Else
' update the last 5 scores
Dim scores As Variant
scores = Me.Range("A1:A5").Value
Me.Range("A2:A6").Value = scores
' clear the input cell
rg.ClearContents
End If
rg.Select
End If
End Sub
FYI: worksheet functions can also be used to achieve similar results without the need for VBA. Please see the attached workbook for additional examples...
I stumbled upon this feed as I was trying to do something similar. On its own it is doing exactly what I want it to however I am trying to get a spreadsheet to work on a slightly larger scale.
I updated the code to keep the 10 most recent data entries instead of 5 easily enough, however I am curious to know is it possible to extend out the code to keep track of and update multiple sets of data in the one spreadsheet say a column for every student in a class?
If I had a class of 25 students could I set it up to keep track of all of their most recent results?
biza_j With a setup like this, where the new scores are input in row 2...
Multi-column setup
...you could try the following modified code:
Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) 'Stop the macro if more than one cell was changed If Target.Cells.Count > 1 Then Exit Sub 'Verify an input cell in row 2 was changed and is not blank Dim rg As Range, lastCol As Long lastCol = Me.Cells(1, Me.Columns.Count).End(xlToLeft).Column Set rg = Me.Range("A2").Resize(, lastCol) If Not Intersect(Target, rg) Is Nothing And Target.Value <> "" Then ' validate the new score If Not Application.WorksheetFunction.IsNumber(Target.Value) Then ' display validation error MsgBox "Please enter numeric values only", vbCritical, "Invalid Score" Else ' update the last 10 scores Set rg = Target.Resize(10) rg.Offset(1).Value = rg.Value ' clear the input cell Target.ClearContents End If Target.Select End If End SubThank you,
The first column is still replacing data after the tenth entry, but this is not extending to columns 2 on wards.
Made the adjustment to enter data into row 2 instead of row 1 unless i am messing something else up.
