How do i create a tennis ladder?
Hi,
Hope I have understood your requirement and this helps you on yor way:
Sub TennisLadder()
Dim Winner As String, Loser As String
Dim wRow As Long, lRow As Long, iLastrow As Long
Dim rng As Range, c As Variant
' Column A --- Name of Player
' Column B --- count of games played
' Column C --- count of games won
' Column D --- count of games lost
'
'
Winner = "Player 2" ' Test Data
Loser = "Player 7" ' Test Data
iLastrow = Cells(Rows.Count, "A").End(xlUp).Row
Set rng = Range("a2:a" & iLastrow) ' Assume header row
With rng
' Find Winner
Set c = .Find(Winner, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
wRow = c.Row
' increment count of games played
Cells(c.Row, 1).Offset(0, 1) = Cells(c.Row, 1).Offset(0, 1) + 1
' increment count of games won
Cells(c.Row, 1).Offset(0, 2) = Cells(c.Row, 1).Offset(0, 2) + 1
End If
' Find Loser
Set c = .Find(Loser, LookIn:=xlValues)
If Not c Is Nothing Then
lRow = c.Row
' increment count of games played
Cells(c.Row, 1).Offset(0, 1) = Cells(c.Row, 1).Offset(0, 1) + 1
' increment count of games Lost
Cells(c.Row, 1).Offset(0, 3) = Cells(c.Row, 1).Offset(0, 3) + 1
End If
End With
Rows(lRow).Select
Selection.Insert Shift:=xlDown
Rows(wRow + 1).EntireRow.Cut Rows(lRow)
Rows(wRow + 1).Delete Shift:=xlUp
End Sub
"Gramps" wrote:
Ladder positions change based on challenge matches played. Example: Player
12 challenges Player 6 and wins. Player 12 now replaces Player 6 on the
"Ladder" and Player 6 becomes 7. All of the players below 6 move down one
rung. You shoud be able to print out the current "Ladder" as well as each
individuals won/lost record.
|