Ladder League Workbook, replace one row with another

[CordingBags]

My local bowls club has asked me to create a spreadsheet to manage a ladder league.
Having looked around I can only find a Google Sheets example that doesn't allow the flexibility we want or hosting sites which are either reportedly unreliable or again inflexible and not really the way we would like to proceed. Ladder leagues seem popular in racquet sports but I guess the sport doesn't really matter.

I have therefore decided to ignore the details of challenges, validity, results etc and concentrate purely on outcomes.

I need a macro to follow the logic:

1. Ask the administrator for the row number of the successful challenger
2. Ask the administrator for the row number of the defeated opponent

The macro should then move the row of the defeated down one and replace the gap with row of the victor. Then close up the gap row of the victor.

3. A check box "is this the expected outcome?" would be nice, but definitely not essential

For example row 13 has challenged and beaten row 10.
row 10 becomes 11, row 13 is moved to row 10, original 11 becomes 12, original 12 becomes 13. No gaps are left nor need changing below row 13.

We envisage the maximum challenge distance as 5 places but circumstance could mean this is nine in reality. eg 15 challenges 10 but in the meanwhile the result of other matches between 16 & 11, 17 & 12, 18 & 13 and 19 & 14 have all gone the way of the challenger, 15 has become 19 by the effect of these results but 10 hasn't moved. In the event that original row 15 (administrator would enter 19 for challenger) is successful it would replace 10 and everyone moves down one.

The macro is doing the same thing, which row needs to move up, which row needs to move down/be replaced. Where is the gap that needs to be closed.

An unsuccessful challenge would make no change to the rows.

I have described this as moving rows, but if cells are a better reference please advise.

Any Help Appreciated, unfortunately I cannot upload any example as I don't really know where to start, apart from a familiarity of where and how to use macros. Club uses EXCEL 2016.

Many Thanks

Paul

 

[JGordon11]

Change Set StartCell = [b2] to the cell where the names start

Sub UpdateLadder()
    Dim coll As New Collection, i As Long, r, rr, winner, loser, c, accept As Long, StartCell As Range, rng As Range, msg As String
    Const MaxDistance = 5
    
    Set StartCell = [b2]
    Set rng = Range(StartCell, StartCell.End(xlDown))
    r = rng
    rr = r

    For i = 1 To UBound(r)
        coll.Add r(i, 1)
    Next
    
    winner = InputBox("Winning player's current ladder position?")
        If Len(winner) = 0 Then Exit Sub
    loser = InputBox("Losing player's current ladder position?")
        If Len(loser) = 0 Then Exit Sub
    
    If Not IsNumeric(winner) Or Not IsNumeric(loser) Then
        MsgBox "Non-numeric input detected"
        Exit Sub
    End If
    
    loser = --loser
    winner = --winner
    
    If winner <= loser Then
        MsgBox "Winner's position is higher on the ladder than the losing player's position.  No changes made."
        Exit Sub
    End If
    
    If winner < 1 Or winner > rng.Rows.Count Or loser < 1 Or loser > rng.Rows.Count Then GoTo ErrorHandler:
    
    If winner - loser > MaxDistance Then
        accept = MsgBox("Max challenge distance of " & MaxDistance & " exceeded.  Continue anyway?", vbOKCancel)
        If accept = vbCancel Then Exit Sub
    End If
    
    On Error GoTo ErrorHandler:
    msg = "#" & winner & " " & StartCell.Offset(winner - 1, 0) & " defeated " & "#" & loser & " " & StartCell.Offset(loser - 1, 0) & ". Is this correct?"
    accept = MsgBox(msg, vbYesNo)
    If accept = vbNo Then Exit Sub
    
    coll.Remove winner
    coll.Add r(winner, 1), , loser
    
    i = 1
    For Each c In coll
        r(i, 1) = c
        i = i + 1
    Next
    
    rng = r
    With StartCell.Offset(loser - 1, 0)
        .Interior.Color = 5296274
        .Offset(1, 0).Interior.Color = 255
        
        accept = MsgBox("Accept changes?", vbYesNo)
        If accept = vbNo Then
            rng = rr
        End If
                
        .Interior.Pattern = xlNone
        .Offset(1, 0).Interior.Pattern = xlNone
    End With
    
    Exit Sub
    
ErrorHandler:
    MsgBox "Input outside of range"
End Sub

 

[CordingBags]

Change Set StartCell = [b2] to the cell where the names start

Sub UpdateLadder()
    Dim coll As New Collection, i As Long, r, rr, winner, loser, c, accept As Long, StartCell As Range, rng As Range, msg As String
    Const MaxDistance = 5
   
    Set StartCell = [b2]
    Set rng = Range(StartCell, StartCell.End(xlDown))
    r = rng
    rr = r

    For i = 1 To UBound(r)
        coll.Add r(i, 1)
    Next
   
    winner = InputBox("Winning player's current ladder position?")
        If Len(winner) = 0 Then Exit Sub
    loser = InputBox("Losing player's current ladder position?")
        If Len(loser) = 0 Then Exit Sub
   
    If Not IsNumeric(winner) Or Not IsNumeric(loser) Then
        MsgBox "Non-numeric input detected"
        Exit Sub
    End If
   
    loser = --loser
    winner = --winner
   
    If winner <= loser Then
        MsgBox "Winner's position is higher on the ladder than the losing player's position.  No changes made."
        Exit Sub
    End If
   
    If winner < 1 Or winner > rng.Rows.Count Or loser < 1 Or loser > rng.Rows.Count Then GoTo ErrorHandler:
   
    If winner - loser > MaxDistance Then
        accept = MsgBox("Max challenge distance of " & MaxDistance & " exceeded.  Continue anyway?", vbOKCancel)
        If accept = vbCancel Then Exit Sub
    End If
   
    On Error GoTo ErrorHandler:
    msg = "#" & winner & " " & StartCell.Offset(winner - 1, 0) & " defeated " & "#" & loser & " " & StartCell.Offset(loser - 1, 0) & ". Is this correct?"
    accept = MsgBox(msg, vbYesNo)
    If accept = vbNo Then Exit Sub
   
    coll.Remove winner
    coll.Add r(winner, 1), , loser
   
    i = 1
    For Each c In coll
        r(i, 1) = c
        i = i + 1
    Next
   
    rng = r
    With StartCell.Offset(loser - 1, 0)
        .Interior.Color = 5296274
        .Offset(1, 0).Interior.Color = 255
       
        accept = MsgBox("Accept changes?", vbYesNo)
        If accept = vbNo Then
            rng = rr
        End If
               
        .Interior.Pattern = xlNone
        .Offset(1, 0).Interior.Pattern = xlNone
    End With
   
    Exit Sub
   
ErrorHandler:
    MsgBox "Input outside of range"
End Sub

Great Thanks
Cheers
Paul