I've got a solution worked up for you. Instead of using dropdown boxes though, I have you click the cell containing the name of the player and hit a commandbutton labeled "Win" or "Lose" as appropriate. The sheet includes three named ranges, four buttons (win, lose, reset, and excecute), and each button has a macro. I made the following assumptions:
Row 1 is a header row
Column A is player rank numbers
Column B is player names
I used column C for the W or L resulut of the current game
Column D totals up the wins
Column E totals up the losses
Columns F and G contain the re-ranking formulas, and should be hidden once the sheet works. They look wrong except when you've chosen both a winner and a loser.
Named ranges:
A range named "players", which includes all the names in column B. This formula will accommodate any number of players, so if your group shrinks or grows this will still work. Insert\Name\Define, use this formula:
Code:
=OFFSET(Sheet1!$B$1,1,0,COUNT(Sheet1!$A:$A),1)
A range named "newranks":
Code:
=OFFSET(Sheet1!$F$1,1,0,COUNT(Sheet1!$A:$A),1)
And a range named "newplayers":
Code:
=OFFSET(Sheet1!$G$1,1,0,COUNT(Sheet1!$A:$A),1)
These names are used both in the macros and on the sheet.
The macros:
Create four buttons, in this order:
CommandButton1 will be the "Win" button
CommandButton2 will be the "Loss" button
CommandButton3 will be the "Reset" button
CommandButton4 will be the "Excecute" button
Asign the following code to those buttons:
Code:
Public winnerrow As Long
Public loserrow As Long
'Code created by mrexcel.com member gardnertoo
Private Sub CommandButton1_Click()
'Choose and highlight the winner
With Selection
Set isect = Application.Intersect(Range("players"), ActiveCell)
If isect Is Nothing Then
MsgBox ("Select a cell in the 'Player' column")
Else
.Interior.ColorIndex = 4 '4 = green = win
Cells(.Row, .Column + 1).Value = "W"
Cells(.Row, .Column + 2).Value = Cells(.Row, .Column + 2).Value + 1
winnerrow = .Row
CommandButton1.Visible = False
CommandButton3.Visible = True
End If
End With
End Sub
Private Sub CommandButton2_Click()
'Choose and highlight the loser
With Selection
Set isect = Application.Intersect(Range("players"), ActiveCell)
If isect Is Nothing Then
MsgBox ("Select a cell in the 'Player' column")
Else
.Interior.ColorIndex = 3 '3 = red = loss
Cells(.Row, .Column + 1).Value = "L"
Cells(.Row, .Column + 3).Value = Cells(.Row, .Column + 3).Value + 1
loserrow = .Row
CommandButton2.Visible = False
CommandButton3.Visible = True
End If
End With
End Sub
Private Sub CommandButton3_Click()
'Reset winner and loser, re-show the buttons
'Un-highlight
With Range("players")
.Interior.ColorIndex = 0
.Offset(0, 1).Value = ""
End With
If winnerrow = 0 Then GoTo showbuttons
If loserrow = 0 Then GoTo showbuttons
'Back out the additional win and loss
Cells(winnerrow, 4).Value = Application.Max(0, Cells(winnerrow, 4).Value - 1)
Cells(loserrow, 5).Value = Application.Max(0, Cells(loserrow, 5).Value - 1)
showbuttons:
'Show the "Win" and "Loss" buttons again
CommandButton1.Visible = True
CommandButton2.Visible = True
CommandButton3.Visible = False
End Sub
Private Sub CommandButton4_Click()
'Move the rankings, unhighlight, re-show the buttons
If winnerrow < loserrow Then
MsgBox ("No change in rankings")
Else
'Winner takes loser's spot
'Loser, and everyboy above the winner, moves down one
Range("players").Value = Range("newplayers").Value
Range("wins").Value = Range("newwins").Value
Range("losses").Value = Range("newlosses").Value
End If
'Un-highlight
With Range("players")
.Interior.ColorIndex = 0
.Offset(0, 1).Value = ""
End With
'Show the "Win" and "Loss" buttons again
CommandButton1.Visible = True
CommandButton2.Visible = True
CommandButton3.Visible = False
End Sub