Pull highest score from Range

[Jerk24]

Good afternoon

I have a sheet (have been here before modifying it) for my dart league and I want to pull the highest game from a range of number inside a cell

So below is a snap shot of where the data is input. each Wk will have the equation something like =14+23+25 (different for all shooter, obviously) for each game.

I already have a code running to pull the highest game over all for each shoot (also included in post) now all i want is the highest game the last week shot (not sure if this is editable to pick up indivdual vaules. =LOOKUP(2,1/(1-ISBLANK(C3:K3)),C3:K3)
not sure if a Formula will work

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Long, Pluses As String, Numbers As Variant, Rng As Range
Const SetOffsets As Long = 4
For x = 0 To 147
If Not Intersect(Target, Range("C3:K3,C5:K5").Offset(x * SetOffsets)) Is Nothing Then
Set Rng = Range("C3:K3,C5:K5").Offset(x * SetOffsets)
GoTo Continue
End If
Next
Exit Sub
Continue:
With WorksheetFunction
Pluses = .Trim(Join(.Index(Rng.Areas(1).Formula, 1, 0), " ")) & _
"+" & .Trim(Join(.Index(Rng.Areas(2).Formula, 1, 0), " "))
Pluses = Replace(.Trim(Replace(Replace(Pluses, "+", " "), "=", " ")), "ABS", 0, , , vbTextCompare)
Cells(Rng(1).Row + 2, "O").Value = Evaluate("MAX(" & Replace(Pluses, " ", ",") & ")")
End With
End Sub


hope this is enough information

---

[TABLE="width: 413"]
<tbody>[TR]
[TD]Wk 1
[/TD]
[TD]Wk 2
[/TD]
[TD]Wk 3
[/TD]
[TD]Wk 4
[/TD]
[TD]Wk 5
[/TD]
[TD]Wk 6
[/TD]
[TD]Wk 7
[/TD]
[TD]Wk 8
[/TD]
[TD]Wk 9
[/TD]
[/TR]
[TR]
[TD]67
[/TD]
[TD]ABS
[/TD]
[TD]63
[/TD]
[TD]68
[/TD]
[TD]56
[/TD]
[TD]ABS
[/TD]
[TD]77
[/TD]
[TD]58
[/TD]
[TD]65
[/TD]
[/TR]
[TR]
[TD]Wk10
[/TD]
[TD]Wk11
[/TD]
[TD]Wk12
[/TD]
[TD]Wk13
[/TD]
[TD]Wk14
[/TD]
[TD]Wk15
[/TD]
[TD]Wk 16
[/TD]
[TD]Wk 17
[/TD]
[TD]Wk 18
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]



[/TD]
[/TR]
</tbody>[/TABLE]

 

[Jerk24]

reading through this again. I will need the single highest game in Column Y.

thanks -

 

[mumps]

Try:

Sub Test()
    Application.ScreenUpdating = False
    Dim lastCell As Range
    Dim x As Long
    Dim rng As Range
    Dim pts1 As String
    Dim pts2 As String
    Dim pts3 As String
    Dim pts4 As String
    Dim LastRow As Long
    LastRow = 193
    For x = 3 To LastRow Step 4
        Set rng = Application.Union(Range("C" & x & ":K" & x), Range("C" & x + 2 & ":K" & x + 2))
        Set lastCell = rng.Find(What:="*", After:=Range("C" & x), _
        LookAt:=xlWhole, LookIn:=xlValues, SearchDirection:=xlPrevious)
        On Error Resume Next
        pts4 = Split(lastCell.Formula, "+")(0)
        pts2 = Split(lastCell.Formula, "+")(1)
        pts3 = Split(lastCell.Formula, "+")(2)
        pts1 = Right(pts4, Len(pts4) - 1)
        Range("Z1") = pts4
        Range("Z2") = pts2
        Range("Z3") = pts3
        If lastCell = "ABS" Then
            Range("V" & x - 1) = 0
        Else
            Range("V" & x - 1) = WorksheetFunction.Max(Range("Z1:Z3"))
        End If
        Range("Z1:Z3").ClearContents
    Next x
    Application.ScreenUpdating = True
End Sub

 

[Jerk24]

this works like a charm. Thank you very much.

 

[mumps]

My pleasure.

 

[Jerk24]

Is there a way to make this automatic, I have been messing around trying to add it to the current event code I have, no dice.

 

[mumps]

The macro that I suggested has to be placed in a regular module and run separately. It cannot work as a Worksheet_Change event because the total scores for each week in your worksheet are returned by a formula. A change in a cell that is returned by a formula will not trigger a Worksheet_Change macro so it must be run manually.