Не заполняется список

If Not Me.list2.RowSource = "" Then
   If Me.takeAll = True Then
      Dim rst As DAO.Recordset, gg_new As String, mview As String
      Set rst = Me.list2.Recordset
    
      If Not (rst.EOF And rst.BOF) Then
         Dim a As String
         rst.MoveFirst
         Do Until rst.EOF
             mview = rst.Fields(1)
             gg_new = IIf(gg_new = "", mview, gg_new & ";" & mview)
             rst.MoveNext
         Loop
      End If
 
      Me.List3.RowSource = gg_new
      Me.List3.Requery
   
      rst.Close
      Set rst = Nothing
   Else
      Me.List3.RowSource = vbNullString
   End If
End If

Me.List2.RowSource = vbNullString
Me.List3.RowSource = vbNullString

Me.List2.RowSource = vbNullString

Set rst = Me.list2.Recordset

  If Me.List.ListIndex = -1 Then Exit Sub
  If Me.List.ListIndex = Me.List.ListCount - 1 Then Exit Sub
  Dim Name1 As String, Name2 As String
  Dim pos1 As Integer, pos2 As Integer
  Dim ctlList As Control, varItem As Variant
 
  'извлекаем данные из выделенной строки
  Set ctlList = Me.List
  For Each varItem In ctlList.ItemsSelected
    Name1 = ctlList.Column(0) & ";" & ctlList.Column(1)
    pos1 = varItem
    pos2 = pos1 + 1
  Next varItem
  
  Me.List.Selected(pos1) = False
  Me.List.Selected(pos2) = True
  
  'находим данные из следующей строки
  For Each varItem In ctlList.ItemsSelected
    Name2 = ctlList.Column(0) & ";" & ctlList.Column(1)
  Next varItem
  
  'меняем местами данные
  Dim ms() As String
  ms = Split(Me.List.RowSource, ";", 2)
  ms(pos1) = Name2
 ms(pos2) = Name1
 
  Me.List.RowSource = Join(ms, ";")

Private Sub ListResort(ctlList As Control, iDirection%)
'Изменение порядка (пересортировка) элементов в ListBox c фиксированным набором значений
'----------------------------------------------------------------
'Пример применения:
'    ListResort Me!lstTestList, -1 'Вверх
'    ListResort Me!lstTestList, 1  'Вниз
'----------------------------------------------------------------
Dim ArrList() As String
Dim sStartName As String, sEndName As String
Dim iPosStart As Integer, iPosEnd As Integer
Dim intRow%, sVal$, iListCount%, iColumnCount%, iColumn%
 
On Error GoTo ListResort_Err
   
'Проверочки:
    iListCount = ctlList.ListCount
    If ctlList.ListIndex = -1 Then Exit Sub
    If iDirection = -1 Then 'Вверх
        If ctlList.ListIndex = 0 Then Exit Sub 'начало списка
    Else 'Вниз
        If ctlList.ListIndex = ctlList.ListCount - 1 Then Exit Sub
    End If
    
'----------------------------------------------------------------
    ReDim ArrList(-1 To iListCount - 1)
    iColumnCount = ctlList.ColumnCount
 
'
    For intRow = 0 To iListCount - 1
        sVal = ""
        For iColumn = 1 To iColumnCount 'Cобираем строку одного элемента списка
            sVal = sVal & ";" & ctlList.Column(iColumn - 1, intRow)
        Next iColumn
        
        sVal = Mid(sVal, 2) 'Удаляем первое вхождение ";"
        ArrList(intRow) = sVal 'Значение в массив!
        
        If ctlList.Selected(intRow) Then 'Если элемент выделен
            iPosStart = ctlList.ListIndex
            sStartName = sVal
            iPosEnd = iPosStart + iDirection 'Индекс эл. назначения
            
            For iColumn = 1 To iColumnCount 'Cобираем строку одного итема
                sEndName = sEndName & ";" & ctlList.Column(iColumn - 1, iPosEnd)
            Next iColumn
            sEndName = Mid(sEndName, 2)   'Удаляем первое вхождение  ";"
        End If
    Next intRow
 
'Меняем местами данные
    ArrList(iPosStart) = sEndName
    ArrList(iPosEnd) = sStartName
    
'Меняем RowSource
    sVal = Join(ArrList, ";")
    sVal = Mid(sVal, 2) 'удаляем первое ";"
    'Debug.Print "RowSource = " & sVal
    ctlList.RowSource = sVal
 
ListResort_End:
    On Error Resume Next
    Exit Sub
 
ListResort_Err:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in Sub ListResort.", _
        vbCritical, "Произошла ошибка!"
    'Debug.Print "ListResort_Line: " & Erl & "."
    Err.Clear
    Resume ListResort_End
 
End Sub