List Box Move Up/Down/Delete Multiple Rows

[jgspencer]

I have the below code that I use to move rows up or down in a control list box. The list box uses a named range for the data. Currently, if I move the selected row up, it only moves the row above the selection down and the same when I move the row down even if i select multiple rows. I want to be able to:

1. Move multiple rows up and move the row above the selection down below the selection.
2. Move multiple rows down and move the row below the selection up above the selection.
3. Clear the selected row or rows and move the below rows up.

I'm familiar with VBA but not real familiar on how to make this happen. The range I'm using has 20 rows. Any help would be greatly appreciated. Let me know if you need any more information.


Code:

Private Sub MoveDown_Click()
Dim lCurrentListIndex As Long
Dim strRowSource As String
Dim strAddress As String
Dim strSheetName As String

With ListBox1
If .ListIndex < 0 Or .ListIndex = .ListCount - 1 Then Exit Sub
lCurrentListIndex = .ListIndex + 1
strRowSource = .RowSource
strAddress = Range(strRowSource).Address
strSheetName = Range(strRowSource).Parent.Name
.RowSource = vbNullString
With Range(strRowSource)
.Rows(lCurrentListIndex).Cut
.Rows(lCurrentListIndex + 2).Insert Shift:=xlDown
End With
Sheets(strSheetName).Range(strAddress).Name = strRowSource
.RowSource = strRowSource
.Selected(lCurrentListIndex) = True
End With
End Sub


Private Sub MoveUp_Click()
Dim lCurrentListIndex As Long
Dim strRowSource As String
Dim strAddress As String
Dim strSheetName As String

With ListBox1
If .ListIndex < 1 Then Exit Sub
lCurrentListIndex = .ListIndex + 1
strRowSource = .RowSource
strAddress = Range(strRowSource).Address
strSheetName = Range(strRowSource).Parent.Name
.RowSource = vbNullString
With Range(strRowSource)
.Rows(lCurrentListIndex).Cut
.Rows(lCurrentListIndex - 1).Insert Shift:=xlDown
End With
Sheets(strSheetName).Range(strAddress).Name = strRowSource
.RowSource = strRowSource
.Selected(lCurrentListIndex - 2) = True
End With
End Sub