Sorting list box

[art]

I have a list of words of colors from cell A1 to Cell A5, the words, Blue,
Green, Red, Orange, Pink. I made a userform with a list box containing the
list mentioned. I also
added two command buttons, one is Move up, and one is Move down.

Now I want the user to be able to select from the list box one color and
press for E.G. command button "Move up", and the selected color should move
up one row. And if selected "move down", the selected color should move down
one row. This
way the user can sort the list the way it needs to be. Can anyone help me
with this? I need this feature badly.

Please help.

Thanks.

 

[Jim Cone]

I have a demonstration workbook, "Scroll Worksheet List",
available for free upon direct request. The code modules are unlocked.
It scrolls a selected range (up or down) using a Spin button.
Please use your real name and provide your general location.

Remove xxx from my email address...
(e-mail address removed)

--
Jim Cone
Portland, Oregon USA




"art"
wrote in message
I have a list of words of colors from cell A1 to Cell A5, the words, Blue,
Green, Red, Orange, Pink. I made a userform with a list box containing the
list mentioned. I also
added two command buttons, one is Move up, and one is Move down.

Now I want the user to be able to select from the list box one color and
press for E.G. command button "Move up", and the selected color should move
up one row. And if selected "move down", the selected color should move down
one row. This
way the user can sort the list the way it needs to be. Can anyone help me
with this? I need this feature badly.
Please help.
Thanks.

 

[BobT]

Private Sub cmdDown_Click()

Dim myStartCell As String
Dim Found As Boolean

myStartCell = "A1"

'Scan the cells
Range(myStartCell).Select
Found = False
While Not Found And ActiveCell.Value <> ""
If ActiveCell.Value = lstColour Then
Found = True
Else
ActiveCell.Offset(1, 0).Select
End If
Wend

'Swap
temp = lstColour.Value
ActiveCell.Value = ActiveCell.Offset(1, 0).Value
ActiveCell.Offset(1, 0).Value = temp

'Reset the list
While lstColour.ListCount <> 0
lstColour.RemoveItem (0)
Wend

Range(myStartCell).Select

While ActiveCell.Value <> ""

lstColour.AddItem ActiveCell.Value
ActiveCell.Offset(1, 0).Select

Wend

End Sub

For you UP button, just change the 1's in swap section to -1.

Bob Tulk
MOUS(XP/97)

 

[art]

Can you just post the code here?

 

[art]

Not working, error by "temp = lstColour.Value".

Any special instructions how to do this?

Thanks.

 

[keiji kounoike]

I don't know how you set values to Listbox, so I use Rowsource Property
to set values for simplicity. a code below has redundant parts, but try it.

Private Sub UserForm_Initialize()
ListBox1.RowSource = "'Sheet1'!a1:a5" '<==Change if not
End Sub

Private Sub CmdMoveDown_Click()
Dim i As Long
Dim base As Range
Set base = Worksheets("Sheet1").Range("a1") '<==Change if not
i = ListBox1.ListIndex
If i <> 0 Then
SwapRVal base.Offset(i, 0), base.Offset(i - 1)
ListBox1.Selected(i - 1) = True
End If
End Sub

Private Sub CmdMoveUp_Click()
Dim i As Long
Dim base As Range
Set base = Worksheets("Sheet1").Range("a1") '<==Change if not
i = ListBox1.ListIndex
If i <> ListBox1.ListCount - 1 Then
SwapRVal base.Offset(i, 0), base.Offset(i + 1)
ListBox1.Selected(i + 1) = True
End If
End Sub

Private Function SwapRVal(rng1 As Range, rng2 As Range)
Dim tmp
tmp = rng1
rng1 = rng2
rng2 = tmp
End Function

keiji

 

[art]

Thanks, it works great.

What I need now is a little more complicated. I have a list in a sheet from
A1 to A500. Each cell has a formula something like =Sheet1!A1, then
Sheet1!A2, and so on, untill Cell A25 then =Sheet2!A1 and so on. What I
really want to do is have in the list box a list of all sheets in the
workbook, and then when I arrange the order of the sheets, I want the order
of my list containing the formulas, should arrange accordingly to the order
what I arranged. For example if I want sheet 2 to be the first in the list,
then my list with formulas should change starting from =Sheet2!A1... and then
=Sheet1!A1.

In short I want to sort the list of formulas according the order of the list
of sheets that I arrange.

Thanks.

Please help me.

 

[keiji kounoike]

i assume your list of sheet's name reside in worksheets("list") and the
list of sheet's name reside in worksheets("formulasheet") in the code
below. after you sort your sheet's name, run the macro below. but i'm
not sure this is what you want. the code below uses a very primitive
way, so it may take a long time if you have many data.

Sub sortformula()
Dim sheetlist, formulalist
Dim tmp, ftmp
Dim i As Long, j As Long
Dim rng As Range, frng As Range

Application.ScreenUpdating = False

With Worksheets("list") '<==Change to the sheet in which sheets name are
sheetlist = .Range(.Range("a1"), .Range("a1").End(xlDown))
End With

With Worksheets("formulasheet") '<==Change to the sheet you want to sort
Set frng = .Range(.Range("a1"), .Range("a1").End(xlDown))
formulalist = frng.Formula

..Columns(1).Insert

For i = 1 To UBound(formulalist)
tmp = Split(formulalist(i, 1), "!")
ftmp = tmp(0) & "!" & Range(tmp(1)).Address(True, True)
.Cells(i, 1) = Replace(tmp(0), "=", "")
formulalist(i, 1) = ftmp
Next

frng.Formula = formulalist
j = 1
For i = 1 To UBound(sheetlist)
Set rng = .Columns(1).Find(sheetlist(i, 1), after:= _
.Cells(Rows.Count, "A"), LookIn:=xlValues, lookat:=xlWhole)
If Not rng Is Nothing Then
Do
rng.Value = j
Set rng = .Columns(1).Find(sheetlist(i, 1), after:= _
.Cells(Rows.Count, "A"), LookIn:=xlValues, lookat:=xlWhole)
j = j + 1
Loop While Not rng Is Nothing
End If
Next
.Range("A1").CurrentRegion.Sort Key1:=Range("A1"), _
Order1:=xlAscending, Header:=xlNo
.Columns(1).Delete
End With

For Each rng In frng
rng.Formula = Replace(rng.Formula, "$", "")
Next

End Sub

keiji