Reorder list with formula or VBA

[Jlragr]

Hi all,

I’m working on a small task for work where we have a list of technicians who do a task. We are asked in order, to do that task but if someone says yes, they move to the bottom of the list and if someone says no, they stay where they are in the list.

For example, the original list starting from the top or who is first to be asked is as follows:

Jenn
Jessica
Rhiannon
Briana
Andrew

Let’s say Jenn was asked to do a task but was unable to, so her response was no, she would stay in her spot within the list. Jessica would be asked next and if she says yes, would move to the bottom of the list and everyone after her would move up. So in this case the list would now look as follows:

Jenn
Rhiannon
Briana
Andrew
Jessica

Is there a formula or a way to code this?
As technicians are asked, our manager would log it into the sheet with our name and our response.

I would like for the VBA or formula to get the techs name and response, and if their response is yes, automatically update the order of the list accordingly. It would be even better if i could incorporate a button to click after the information has been entered to do this instead of pulling up the macro window every time, as our manager is not tech savvy whatsoever.

Thanks in advance and let me know if there’s any more information you’d need to make this easier to understand.

Also, apologies, I’m currently not at work (it’s my day off) so i don’t have access to the file to be able to upload an example of how I’ve set it up so far.

 

[Sektor]

I don't know the exact dislocation of your data, but here's example workbook how it could work. Just enter "Yes" to the right of any name, and it will move to the end. When workbook is being opened, it writes array of names into dictionary and then it's being update as you type "Yes".

In Module1:

Public dict As Object

Sub Auto_Open()
  Dim r As Long
  Set dict = CreateObject("Scripting.Dictionary")
  For r = 1 To 5
    dict.Add Key:=r, Item:=[A1:A5].Item(r)
  Next
End Sub

In Sheet1 worksheet module:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rw As Long
  Dim this_row As Long
  Dim curr_name As String
  If Intersect([A1:A5].Offset(, 1), Target) Is Nothing Then Exit Sub
  If Target.Value = "Yes" Then
    curr_name = Target.Offset(, -1)
    this_row = Target.Row
    For rw = this_row + 1 To dict.Count
      dict(rw - 1) = [A1:A5].Item(rw)
    Next
    dict(dict.Count) = curr_name
    '// Disable recursion
    Application.EnableEvents = False
    For rw = 1 To dict.Count
      Cells(rw, "A") = dict(rw)
    Next
    Application.EnableEvents = True
  End If
End Sub

 

[sfpowell]

With a spreadsheet setup like this:

Where cell B1 is a Data Validation list with a source of =D:D

I wrote the following VBA code on the worksheet:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Ws As Worksheet
Dim lRow As Long
    If Not Application.EnableEvents Then Exit Sub
    If Not Intersect(Target, Me.Range("B1")) Is Nothing Then
        Application.EnableEvents = False        
        Set Ws = ActiveSheet        
        lRow = 1
        Do
            If Ws.Range("D" & lRow) = Ws.Range("B1") Or Ws.Range("D" & lRow) = "" Then
                If Ws.Range("D" & lRow + 1) <> "" Then
                    Ws.Range("D" & lRow + 1).Cut Destination:=Ws.Range("D" & lRow)
                    If Ws.Range("D" & lRow + 2) = "" Then
                        Ws.Range("D" & lRow + 1) = Ws.Range("B1")
                    End If
                End If
            End If
            lRow = lRow + 1
        Loop Until Ws.Range("D" & lRow + 1) = ""        
        Application.EnableEvents = True                
    End If    
End Sub

Now whenever you select a name from the drop down list in cell B1, it reorders this list in column D. Does that get you going?

There's no error checking built into the code at this point, so you would need to make sure the list of names starts in D1 and there's no gaps.

 

[Jlragr]

hey guys, thanks for the examples! greatly appreciated, this is how the worksheet is currently set up.