Wrote code to input data in a2 and b2, then sort that through row 2. How do I change this code to allow every row to operated the same way. Any help would be deeply appreciated, I'm new at writing code and I am stuck on this.
Sub NewScoreEntry()
'Keyboard Shortcut Ctrl + q
Dim High As Long
Dim rLook As Range
Dim Biggest As Variant
Dim Where As String
Dim ws As Worksheet
Set ws = ActiveSheet
Dim lastCol As Long
Dim Day As String
' Finds the highest score of 5 that count
' High = Highest Score
High = WorksheetFunction.Max(Range("d2,f2,h2,j2,l2"))
' Finds the Cell containing highest score
' Where = Cell with the Highest Score
Set rLook = Range("d2,f2,h2,j2,l2")
Biggest = Application.WorksheetFunction.Max(rLook)
Where = rLook.Find(What:=Biggest, After:=rLook(1)).Address
' day = the actual date
Day = Range(Where).Offset(0, -1)
' dayadd = the date address
Dayadd = Range(Where).Offset(0, -1).Address
'paste date in next blank column
If High > Range("b2").Value Then
lastCol = Cells(2, Columns.Count).End(xlToLeft).Column
Range(Dayadd).Copy
Cells(2, lastCol + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("a2").Copy
Range(Dayadd).PasteSpecial xlPasteValues
End If
'paste high score in next blank column
If High > Range("b2").Value Then
lastCol = Cells(2, Columns.Count).End(xlToLeft).Column
Range(Where).Copy
Cells(2, lastCol + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("b2").Copy
Range(Where).PasteSpecial xlPasteValues
End If
'paste new date of high score in next blank column
If High < Range("b2").Value Then
lastCol = Cells(2, Columns.Count).End(xlToLeft).Column
Range("a2").Copy
Cells(2, lastCol + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
'paste new high score in next blank column
If High < Range("b2").Value Then
lastCol = Cells(2, Columns.Count).End(xlToLeft).Column
Range("b2").Copy
Cells(2, lastCol + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
'if scores are equal (date)
If High = Range("b2").Value Then
lastCol = Cells(2, Columns.Count).End(xlToLeft).Column
Range("a2").Copy
Cells(2, lastCol + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
'if scores are equal(score)
If High = Range("b2").Value Then
lastCol = Cells(2, Columns.Count).End(xlToLeft).Column
Range("b2").Copy
Cells(2, lastCol + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End Sub