Applying code written for one row of data to every row in the worksheet

  • 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