ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   How do i create a tennis ladder? (https://www.excelbanter.com/excel-programming/328189-how-do-i-create-tennis-ladder.html)

gramps

How do i create a tennis ladder?
 
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.

Toppers

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.


gramps

How do i create a tennis ladder?
 
Thanks for responding,
I'm sure your suggestion would help if I had a limited understanding of
Visual Basics. My experience is limited to adding data, formulas and a few
functions to Excel spredsheets. I have never tried to enter "code" nor do I
know what to do with it after I type it in.
Gramps

"Toppers" wrote:

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.


Toppers

How do i create a tennis ladder?
 
Hi,
Do you know how to get into Visual Basic and the Visual Basic Editor?
If you don't, is there anyone who can help you? If not, if you want to send
me an e-mail ) I'll put together some brief
instructions to get you started annd/or send you a spreadsheet with the code
in.

But if you want to progress much further you may have consider learning some
VB(Visual Basic for Applications). You will need to use this to solve more
complex problems.

HTH


"Gramps" wrote:

Thanks for responding,
I'm sure your suggestion would help if I had a limited understanding of
Visual Basics. My experience is limited to adding data, formulas and a few
functions to Excel spredsheets. I have never tried to enter "code" nor do I
know what to do with it after I type it in.
Gramps

"Toppers" wrote:

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.



All times are GMT +1. The time now is 02:11 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com