Moving Mutli-Column Multiple-Selected Listbox items up or down
 

Currently using this code to move single mult-colum list box items up.. How
do I modify the code to move muliple selected items up?

Application.ScreenUpdating = False
Dim lCurrentListIndex As Long
Dim strRowSource As String
Dim strAddress As String
Dim strSheetName As String

With TOP200

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
Application.ScreenUpdating = True