Technique to move (reorder) items in Listbox

  • Thread starter Thread starter Stuart
  • Start date Start date
S

Stuart

I'm sure I've seen somewhere (but cannot locate now)
code that will allow the user to change the order of
items in a listbox.

I want to use this code to allow a user to change the
tab order of worksheets, and thought I could populate
the listbox with the sheet names.

Can anyone help, please?

Regards.
 
Selecting an item and using a spinbutton?

just remove the item and add it back at the appropriate location (one
position up or down).
 
Stuart,

Nor answering the question , but by taborder of worksheets, I assume you
mean order. On this basis, I present here a utility that allows you to
specify the sheet order, and it then orders them for you.

'---------------------------------------------------------------------
Sub dlgSheetSort()
'---------------------------------------------------------------------
'Function: Custom sheet order dialog
'Author: Originally written by John Walkenbach
' Adapted and enhanced by Bob Phillips
'Synopsis: Builds a print dialog with a list of worksheets with
' current sheet order.
' The dialog is then displayed to allow setting of
' custom sheet order.
' Igf OK, order macro called.
' Finaly dialog is cleared down
'---------------------------------------------------------------------
Const sTitle As String = "Custom Sheet Order"
Const sMsgTitle As String = "Custom Order"
Const sID As String = "___CustOrder"
Dim PrintDlg As DialogSheet
Dim oThis As Workbook
Dim CurrentSheet As Worksheet
Dim oCtl As EditBox
Dim nBinary As Long
Dim i As Long
Dim j As Long
Dim iTopPos As Long
Dim iItems As Long
Dim aryOrder()

Application.ScreenUpdating = False

Set oThis = ActiveWorkbook

If oThis.ProtectStructure Then
MsgBox "Workbook is protected.", vbCritical, sMsgTitle
Exit Sub
End If

Set CurrentSheet = ActiveSheet
Set PrintDlg = oThis.DialogSheets.Add
With PrintDlg

.Name = sID
.Visible = xlSheetHidden

iItems = 0

iTopPos = 40
For i = 1 To oThis.Sheets.Count
'skip hidden sheets
If oThis.Sheets(i).Visible <> xlSheetHidden Then
If oThis.Sheets(i).Name <> sID Then
iItems = iItems + 1
.Labels.Add 78, iTopPos, 150, 16.5
.EditBoxes.Add 200, iTopPos, 24, 16.5
.EditBoxes(iItems).Caption = iItems
.Labels(iItems).Text = _
oThis.Sheets(i).Name
iTopPos = iTopPos + 13
End If
End If
Next i

.Buttons.Left = 240

With .DialogFrame
.Height = Application.Max(68, .Top + iTopPos - 34)
.Width = 230
.Caption = sTitle
End With

' Change tab order of OK and Cancel buttons
' so the 1st option button will have the focus
.Buttons("Button 2").BringToFront
.Buttons("Button 3").BringToFront

.Buttons("Button 3").OnAction = "CancelButton"

Application.ScreenUpdating = True
Do
If .Show Then
fCancel = False
nBinary = 0
For Each oCtl In .EditBoxes
If oCtl.Caption <> "" Then
nBinary = nBinary + 2 ^ (oCtl.Caption - 1)
End If
Next oCtl
If nBinary <> 2 ^ iItems - 1 Then
MsgBox "invalid"
End If
End If
Loop Until nBinary = 2 ^ iItems - 1 Or fCancel

'If everything OK and not cancel
If Not fCancel Then
ReDim aryOrder(1 To .EditBoxes.Count)
For i = .EditBoxes.Count To 1 Step -1
For j = 1 To .EditBoxes.Count
If i = .EditBoxes(j).Caption Then
aryOrder(i) = .Labels(j).Text
Exit For
End If
Next j
Next i
Ordersheets aryOrder
End If

Application.DisplayAlerts = False
.Delete

End With

End Sub

Private Sub Ordersheets(Order)
Dim i As Long
For i = UBound(Order) To LBound(Order) Step -1
Sheets(Order(i)).Move before:=Sheets(1)
Next i
End Sub

Private Sub CancelButton()
fCancel = True
End Sub



--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Many thanks.

I know I'll use it, but I've started to follow Tom's suggestion,
so will also follow that through (for my benefit).

Regards.
 
Thanks for the suggestion. Have amended the spinbox to
MoveUp and MoveDown buttons. Can get sheetnames
into the listbox.

When back in the module, how do I relate the position in
the listbox to the sheet's tab index (I presume that is the route) ?

Regards.
 
I wouldn't move the sheets on each change. Have the user make their
selections, then order the sheets based on the order in the listbox. (or
call the code in CommandButton1_click() whenever you want to reorder the tab
order).

Private Sub CommandButton1_Click()
With ListBox1
For i = .ListCount - 1 To 1 Step -1
Worksheets(.List(i)).Move After:=Worksheets(.List(0))
Next
End With

End Sub

Private Sub SpinButton1_SpinUp()
If ListBox1.ListIndex <> -1 Then
i = ListBox1.ListIndex
If i = 0 Then Exit Sub
s = ListBox1.List(i)
ListBox1.RemoveItem i
ListBox1.AddItem s, i - 1
ListBox1.ListIndex = i - 1
SpinButton1.Value = 0
End If
End Sub

Private Sub SpinButton1_SpinDown()
If ListBox1.ListIndex <> -1 Then
i = ListBox1.ListIndex
If i = ListBox1.ListCount - 1 Then Exit Sub
s = ListBox1.List(i)
ListBox1.RemoveItem i
ListBox1.AddItem s, i + 1
ListBox1.ListIndex = i + 1
SpinButton1.Value = 0
End If
End Sub

Private Sub UserForm_Initialize()
For Each sh In Worksheets
ListBox1.AddItem sh.Name
Next
End Sub
 
I hoped that the moveup/down button code would order
the listbox, then user would click Done. Code would
revert to the module, where the actual sheet tab changes
would be handled.

All that would be seen in the form, would be the apparent
change in the sequence of sheet names .

Many thanks for the spinbutton routines.

Regards.
 
As long as you can see the order of the items in the listbox, the reorder
code should work.

If you hide your userform, then run the reorder in the original module, then
unload the form, it should work fine (preface the references to the listbox
with the userform name. ).
 
Regards and thanks.

Tom Ogilvy said:
As long as you can see the order of the items in the listbox, the reorder
code should work.

If you hide your userform, then run the reorder in the original module, then
unload the form, it should work fine (preface the references to the listbox
with the userform name. ).
Click to expand...
 
Back
Top