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

  • Please read our forum rules as you have violated two of them. Please enclose your code in code tags as noted in the forum rules.


    No further help should be provided until this request is complied with.

Participate now!

Don’t have an account yet? Register yourself now and be a part of our community!