Moving items in Listbox

[christobal]

Have A listbox whos RowSource is Set to A256 to refelect a tabl
filled from previous procedure which allowed user to fill out tabl
region from dropdown listboxes.
Have no problem deleting rows in range but require a procedure whic
will allow the user to select a row in the listbox and move the data u
in the list. The "move " procedure is the final user choice befor
printing the range

 

[Tom Ogilvy]

Using a spin button (can move both up and down)

Private Sub SpinButton1_SpinDown()
Dim sStr As String
Dim rng As Range
Dim idex As Long
Dim topIdex As Long
Const NumItemsVisible As Long = 9
topIdex = ListBox1.TopIndex
Set rng = Range(ListBox1.RowSource)
sStr = ListBox1.RowSource
With ListBox1
If .ListIndex >= 0 And .ListIndex < .ListCount - 1 Then
idex = .ListIndex + 1
.RowSource = ""
varr = rng(idex + 1, 1).Resize(1, 4).Value
rng(idex + 1, 1).Resize(1, 4).Value = _
rng(idex, 1).Resize(1, 4).Value
rng(idex, 1).Resize(1, 4).Value = varr
.RowSource = sStr
.ListIndex = idex
Debug.Print .ListIndex - topIdex, topIdex, .ListIndex
If .ListIndex - topIdex < NumItemsVisible Then
.TopIndex = topIdex
Else
.TopIndex = .ListIndex
End If
SpinButton1.Value = 50
End If
End With
End Sub



Private Sub SpinButton1_SpinUp()
Dim sStr As String
Dim rng As Range
Dim idex As Long
Dim topIdex As Long
topIdex = ListBox1.TopIndex
Set rng = Range(ListBox1.RowSource)
sStr = ListBox1.RowSource
With ListBox1
If .ListIndex > 0 Then
idex = .ListIndex + 1
.RowSource = ""
varr = rng(idex - 1, 1).Resize(1, 4).Value
rng(idex - 1, 1).Resize(1, 4).Value = _
rng(idex, 1).Resize(1, 4).Value
rng(idex, 1).Resize(1, 4).Value = varr
.RowSource = sStr
.ListIndex = idex - 2
If .ListIndex > topIdex Then _
.TopIndex = topIdex
SpinButton1.Value = 50
End If
End With
End Sub