Not sure if heirarchical is the correct term...

What I want to do is have a list box or its equivalent that will display a list of names and allow the user to change the ordering of the list by promoting (either dragging and drop up or using a button) or demoting (dragging down or a button). Is dragging even an option?

The changed order would then be used for report ordering.

Yikes. I wrote a bunch of code recently for this issue. If you search my posts you should find it within the last month or so. There is quite a bit of code to this. THEN you have to figure out how to group based on this data. That should be straightforward if you use a table to hold the results. Let me know where you need the gaps filled in.


mmcdonal

Sorry for the lengthy code, but this works very well. I have a form with a list box (lstMain) and several buttons (item up, item down, add, edit, delete). The text box (txtLineData) displays the item in the list box that is selected. It is used for adding and editing the items.

The list box is populated by the LoadList sub procedure. Here is the code for this form;

Option Compare Database
Option Explicit
Dim lOrigId As Long
Dim iState As Integer

Const iAdd As Integer = 1
Const iEdit As Integer = 2
Const iDelete As Integer = 3

Private Sub cmdAdd_Click()

    Me.txtLineData = ""
    Me.txtLineData.Visible = True
    Me.txtLineData.SetFocus
    Me.cmdAdd.Enabled = False
    Me.cmdEdit.Enabled = False
    Me.cmdDelete.Enabled = False
    Me.cmdSave.Visible = True
    Me.cmdCancel.Visible = True
    iState = iAdd

End Sub

Private Sub cmdCancel_Click()

    Me.lstMain.SetFocus
    Me.cmdAdd.Enabled = True
    Me.cmdDelete.Enabled = True
    Me.cmdEdit.Enabled = True
    Me.cmdCancel.Visible = False
    Me.cmdSave.Visible = False
    Me.txtLineData = ""
    Me.txtLineData.Visible = False

End Sub

Private Sub cmdDelete_Click()

    If MsgBox("Are you sure that you want to delete this record?", vbQuestion + vbYesNo, "Delete confirmation...") = vbYes Then

        DoCmd.SetWarnings False
        DoCmd.RunSQL "Delete * From PandLTemplate Where ID = " & Me.lstMain.Column(1)
        DoCmd.SetWarnings True
        Call LoadList

    End If

End Sub

Private Sub cmdDown_Click()

    'move the item down
    Dim i, io As Integer
    Dim s As String

    If Me.lstMain.ListIndex > Me.lstMain.ListCount - 2 Or Me.lstMain.ListIndex = -1 Then

        Exit Sub

    End If

    'get selected index

    i = Me.lstMain.ListIndex

    'get item at index, again assuming the item is a string

    s = Me.lstMain.Column(0, i)
    io = Me.lstMain.Column(1, i)

    'removing it from the list at the selected index

    Me.lstMain.RemoveItem (i)

    'inserting at the index below

    Me.lstMain.AddItem s & ";" & Str(io), i + 1

    'selecting moved item

    Me.lstMain.Selected(i + 1) = True

End Sub

Private Sub cmdEdit_Click()

    If IsNull(Me.lstMain.ItemsSelected) = False Then

        Me.lstMain.SetFocus
        Me.cmdAdd.Enabled = False
        Me.cmdEdit.Enabled = False
        Me.cmdDelete.Enabled = False
        Me.cmdSave.Visible = True
        Me.cmdCancel.Visible = True
        Me.txtLineData = Me.lstMain.Column(0)
        lOrigId = Me.lstMain.Column(1)
        Me.txtLineData.Visible = True
        Me.txtLineData.SetFocus
        Me.txtLineData.SelStart = Len(Me.lstMain.Column(0))
        iState = iEdit

    End If

End Sub

Private Sub cmdSave_Click()

    If iState = iAdd Then

        If IsNull(Me.txtLineData) = False Then

            DoCmd.SetWarnings False
            DoCmd.RunSQL "Insert into PandLTemplate (Descr, OrderNo) Values ('" & Me.txtLineData & "', 200)"
            DoCmd.SetWarnings True

        End If


    ElseIf iState = iEdit Then

        If IsNull(Me.txtLineData) = False And IsNull(lOrigId) = False And lOrigId > 0 Then

            DoCmd.SetWarnings False
            DoCmd.RunSQL "Update PandLTemplate Set Descr = '" & Me.txtLineData & "' Where ID = " & lOrigId
            DoCmd.SetWarnings True

        End If

    ElseIf iState = iDelete Then

    End If
    Me.lstMain.SetFocus
    Me.cmdAdd.Enabled = True
    Me.cmdDelete.Enabled = True
    Me.cmdEdit.Enabled = True
    Me.cmdCancel.Visible = False
    Me.cmdSave.Visible = False
    Me.txtLineData = ""
    Me.txtLineData.Visible = False

    Me.lstMain.Selected(0) = False
    Me.cmdUp.SetFocus
    lOrigId = 0
    Me.lstMain.RowSource = ""
    Call LoadList

End Sub

Private Sub cmdUp_Click()

    'move the item up
    Dim i, io As Integer
    Dim s As String

    If Me.lstMain.ListIndex < 1 Then

        Exit Sub

    End If

    'get selected index

    i = Me.lstMain.ListIndex

    'get item at index, assuming the item is a string

    s = Me.lstMain.Column(0, i)
    io = Me.lstMain.Column(1, i)

    'removing it from the list at the selected index

    Me.lstMain.RemoveItem (i)

    'inserting at the index above

    Me.lstMain.AddItem s & ";" & Str(io), i - 1

    'selecting moved item

    Me.lstMain.Selected(i - 1) = True

End Sub

Private Sub Form_Close()

    Dim i As Integer
    DoCmd.SetWarnings False

    Me.lstMain.Selected(0) = True

    For i = 0 To Me.lstMain.ListCount - 1

        DoCmd.RunSQL "Update PandLTemplate Set OrderNo = " & Me.lstMain.ListIndex & " Where ID = " & Me.lstMain.Column(1)
        Me.lstMain.Selected(i) = True

    Next i
    DoCmd.SetWarnings True

End Sub

Private Sub Form_Load()

    Me.cmdCancel.Visible = False
    Me.cmdSave.Visible = False
    Me.txtLineData.Visible = False

    Me.lstMain.RowSource = ""
    Me.lstMain.Requery
    Call LoadList
    Me.lstMain.Selected(0) = True

End Sub

Private Sub LoadList()

    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset

    Set cn = CurrentProject.AccessConnection
    Set rs = New ADODB.Recordset

    With rs
        Set .ActiveConnection = cn
        .LockType = adLockOptimistic
        .CursorType = adOpenKeyset
    End With

    rs.Open "Select Descr, ID, OrderNo From PandLTemplate Order By OrderNo"

    Me.lstMain.RowSource = ""
    Me.lstMain.Requery
    Do While rs.EOF = False

        Me.lstMain.AddItem rs("Descr") & ";" & rs("ID")

        rs.MoveNext

    Loop
    If rs.State = adStateOpen Then rs.Close
    If cn.State = adStateOpen Then cn.Close
    Set rs = Nothing
    Set cn = Nothing

End Sub

++++++++++ I hope this helps you. It works great for me. +++++++