Access VBA - How to MOVE item in ListBox Up and Down

Access 2016 VBA Programming - How to MOVE item in ListBox Up and Down.

🎓 Master Visual Basic .NET and Access Database By Building the Point Of Sale System (POS).

📲 Enroll Now: https://bit.ly/2WcbRhX

Related Content:
» How to Transfer data From TextBox To a ListBox Using User Defined Function.
» How to count number of items in a ListBox Control.
Link:— https://goo.gl/Caqmiq

[Screenshot]

[YouTube]

—Part 1/2

—Part 2/2

[Source Code]

Private Sub MoveListBoxItemUpDown(ByVal intDirection As Integer)
Dim style As Integer
Dim caption As String
style = vbInformation + vbOKOnly
caption = "Code A Minute [iBasskung] ^_^"

Dim i As Integer
Dim s As String

Dim lngArraySize As Long
Dim lngCounter As Long
Dim intCurrentRow As Integer

Dim varString As Variant
Dim arrString() As String

lngCounter = 0
lngArraySize = 10

ReDim arrString(lngArraySize)

For i = 0 To Me.ListBox1.ListCount - 1
     If lngCounter > lngArraySize Then
          lngArraySize = lngArraySize + 5
          ReDim Preserve arrString(lngArraySize)
     End If
   
     arrString(lngCounter) = Me.ListBox1.Column(1, lngCounter)
     lngCounter = lngCounter + 1
   
Next i

s = ""

Dim n As Integer
Dim intIndex As Variant
Dim lngSelectedIndex() As Long

If Me.ListBox1.ItemsSelected.Count > 0 Then
     For intCurrentRow = 0 To Me.ListBox1.ListCount - 1
          If Me.ListBox1.Selected(intCurrentRow) Then
               s = s & Me.ListBox1.Column(0, intCurrentRow) & ", " & _
               Me.ListBox1.Column(1, intCurrentRow)
          End If
     Next intCurrentRow
   
Else
   
     MsgBox "You haven't selected an entry in the" _
     & " ListBox.", style, caption
   
     Exit Sub
   
End If

For Each intIndex In Me.ListBox1.ItemsSelected
   
     ReDim Preserve lngSelectedIndex(0 To n)
     lngSelectedIndex(n) = intIndex
     n = n + 1

Next

Select Case intDirection
     Case Is = 0
          For n = LBound(lngSelectedIndex) To UBound(lngSelectedIndex)
             
               If lngSelectedIndex(n) <= LBound(arrString) Then
                    MsgBox "Can not move item " & s & " <Up!>", style, caption
                    Exit Sub
               End If
             
               Me.ListBox1.RemoveItem (lngSelectedIndex(n))
               Me.ListBox1.AddItem s, lngSelectedIndex(n) - 1
               lngSelectedIndex(n) = lngSelectedIndex(n) - 1
             
          Next n
   
     Case Is = 1
   
          For n = LBound(lngSelectedIndex) To UBound(lngSelectedIndex)
               If lngSelectedIndex(n) >= (Me.ListBox1.ListCount - 1) Then
                    MsgBox "Can not move item " & s & " <Down!>", style, caption
                    Exit Sub
                 
               Else
                    Me.ListBox1.RemoveItem (lngSelectedIndex(n))
                    Me.ListBox1.AddItem s, lngSelectedIndex(n) + 1
                    lngSelectedIndex(n) = lngSelectedIndex(n) + 1
               End If
          Next n
       
End Select

For n = LBound(lngSelectedIndex) To UBound(lngSelectedIndex)
     Me.ListBox1.Selected(lngSelectedIndex(n)) = True
Next n

End Sub

Private Sub cmdMoveUp_Click()
     Call MoveListBoxItemUpDown(0)
End Sub

Private Sub cmdMoveDown_Click()
     Call MoveListBoxItemUpDown(1)
End Sub

////
» Thanks for watching and I hope you found this video useful! please don’t forget to like, comment, subscribe and turn your notifications ON to be sure not to miss my next video.

★ Follow me on ★

Twitter
» https://twitter.com/#!/IBasskung

Facebook (English)
» https://www.facebook.com/CodeAMinute

Facebook (ภาษาไทย)
» https://www.facebook.com/IbasskungTutorial

Google+
» https://plus.google.com/u/0/107523775437712370629/posts

YouTube Channel
» http://www.youtube.com/user/TheRockmankung

Dailymotion Channel
» http://www.dailymotion.com/Ibasskung-Courses

Free Source Code can be found here:
» https://goo.gl/UNNzp2

Thank you very much.
ขอบคุณครับ.

#CodeAMinute #AccessVBA #Programming #IbasskungTutorial #IbasskungCourses #MoveListBoxItemUpDown