View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Toppers Toppers is offline
external usenet poster
 
Posts: 4,339
Default 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.