ListBox2.Clear  
   ListBox3.Clear  
   j = Empty  
     
   Dim Subdivision() As Variant  
   Subdivision_start = Sheets("Çàêàç÷èêè").Range("d2:d" & Clients_Last_Row).Find(ListBox1.Value).Row + 1  
   Subdivision_end = Subdivision_start  
   If Sheets("Çàêàç÷èêè").Cells(Subdivision_start, 5).Value <> Empty Then  
       Do While Sheets("Çàêàç÷èêè").Cells(Subdivision_end, 4) = Empty  
           Subdivision_end = Subdivision_end + 1  
       Loop  
       Subdivision_end = Subdivision_end - 1  
   End If  
     
   Subdivisions_Num = Count_nonblank(Sheets("Çàêàç÷èêè").Range(Cells(Subdivision_start, 5), Cells(Subdivision_end, 5)))  
   If Subdivisions_Num <> 0 Then  
       ReDim Subdivision(1 To Subdivisions_Num)  
       For i = Subdivision_start To Subdivision_end  
           If Sheets("Çàêàç÷èêè").Cells(i, 5).Value <> Empty Then  
              j = j + 1  
              Subdivision(j) = Sheets("Çàêàç÷èêè").Cells(i, 5).Value  
              ListBox2.AddItem (Subdivision(j))  
           End If  
       Next i  
   End If

необходимо сделать 3 листбокса, т.о, чтобы в 1м были значения 1го уровня, во 2м - значения 2го уровня соответствующего значения из 1го листбокса (после выбора значения 1го уровня) и тд  
 
т.е. если я выбираю в первом листбоксе 3е значение, то во втором листбоксе отображаются только 3.1, 3.2 и тд.    
после выбора 3.2, в третьем листбоксе отобразятся только 3.2.1 и 3.2.2.    
 
проблема в том, что значения для листбокса 2го уровня раскиданы по строкам, а не идут подряд и для обозначения конца массива для 2го уровня необходимо определить конец 3го значения в 1м уровне.  
собственно, проблема в процедуре ListBox1_AfterUpdate(). остальное работает как надо  
 
Private Sub UserForm_Initialize()  
   Dim Client() As Variant  
   Dim Clients_Num As Integer  
     
   Clients_Last_Row = Sheets("Çàêàç÷èêè").Range("d999").End(xlUp).Row  
   Clients_Num = Count_nonblank(Sheets("Çàêàç÷èêè").Range("d2:d" & Clients_Last_Row))  
   ReDim Client(1 To Clients_Num)  
   For i = 2 To Clients_Last_Row  
       If Sheets("Çàêàç÷èêè").Cells(i, 4).Value <> Empty Then  
          j = j + 1  
          Client(j) = Sheets("Çàêàç÷èêè").Cells(i, 4).Value  
          ListBox1.AddItem (Client(j))  
       End If  
   Next i  
         
   j = Empty  
 
End Sub  
 
Private Sub ListBox1_AfterUpdate()  
             
   ListBox2.Clear  
   ListBox3.Clear  
     
   Choosen_Client = Sheets("Çàêàç÷èêè").Range("d2:d" & Clients_Last_Row).Find(ListBox1.Value).Row  
   Next_Index = ListBox1.TabIndex + 2  
'    Next_Client = Sheets("Çàêàç÷èêè").Range("d2:d" & Clients_Last_Row).Find(ListBox1.Selected(Next_Index).Value).Row  
   Choosen_Client_Subdivisions_Count = Count_nonblank(Sheets("Çàêàç÷èêè").Range(Cells(Choosen_Client + 1, 5), Cells(Next_Client - 1, 5)))  
'    Choosen_Client_Subdivisions_Count = Sheets("Çàêàç÷èêè").Cells(Choosen_Client + 1, 5).End(xlDown).Row  
   If Sheets("Çàêàç÷èêè").Cells(Choosen_Client + 1, 5).Value <> Empty Then  
       For i = Choosen_Client + 1 To Choosen_Client_Subdivisions_Count  
           ListBox2.AddItem (Sheets("Çàêàç÷èêè").Cells(i, 5))  
       Next i  
   End If  
End Sub  
 
Private Sub ListBox2_AfterUpdate()  
             
   ListBox3.Clear  
     
   Choosen_Subdivision = Sheets("Çàêàç÷èêè").Range("e2:e" & Clients_Last_Row).Find(ListBox2.Value).Row  
   Choosen_Subdivision_Services_Count = Sheets("Çàêàç÷èêè").Cells(Choosen_Subdivision + 1, 6).End(xlDown).Row  
   If Sheets("Çàêàç÷èêè").Cells(Choosen_Subdivision + 1, 6).Value <> Empty Then  
       For i = Choosen_Subdivision + 1 To Choosen_Subdivision_Services_Count  
           ListBox3.AddItem (Sheets("Çàêàç÷èêè").Cells(i, 6))  
       Next i  
   End If  
End Sub  
 
 
Function Count_nonblank(x As Range) As Integer  
   Count_nonblank = x.Cells.Count - WorksheetFunction.CountBlank(x)  
End Function

необходимо сделать 3 листбокса, т.о, чтобы в 1м были значения 1го уровня, во 2м - значения 2го уровня соответствующего значения из 1го листбокса (после выбора значения 1го уровня) и тд  
 
т.е. если я выбираю в первом листбоксе 3е значение, то во втором листбоксе отображаются только 3.1, 3.2 и тд.    
после выбора 3.2, в третьем листбоксе отобразятся только 3.2.1 и 3.2.2.    
 
проблема в том, что значения для листбокса 2го уровня раскиданы по строкам, а не идут подряд и для обозначения конца массива для 2го уровня необходимо определить конец 3го значения в 1м уровне.  
собственно, проблема в процедуре ListBox1_AfterUpdate(). остальное работает как надо  
 
Private Sub UserForm_Initialize()  
   Dim Client() As Variant  
   Dim Clients_Num As Integer  
     
   Clients_Last_Row = Sheets("Çàêàç÷èêè").Range("d999").End(xlUp).Row  
   Clients_Num = Count_nonblank(Sheets("Çàêàç÷èêè").Range("d2:d" & Clients_Last_Row))  
   ReDim Client(1 To Clients_Num)  
   For i = 2 To Clients_Last_Row  
       If Sheets("Çàêàç÷èêè").Cells(i, 4).Value <> Empty Then  
          j = j + 1  
          Client(j) = Sheets("Çàêàç÷èêè").Cells(i, 4).Value  
          ListBox1.AddItem (Client(j))  
       End If  
   Next i  
         
   j = Empty  
 
End Sub  
 
Private Sub ListBox1_AfterUpdate()  
             
   ListBox2.Clear  
   ListBox3.Clear  
     
   Choosen_Client = Sheets("Çàêàç÷èêè").Range("d2:d" & Clients_Last_Row).Find(ListBox1.Value).Row  
   Next_Index = ListBox1.TabIndex + 2  
'    Next_Client = Sheets("Çàêàç÷èêè").Range("d2:d" & Clients_Last_Row).Find(ListBox1.Selected(Next_Index).Value).Row  
   Choosen_Client_Subdivisions_Count = Count_nonblank(Sheets("Çàêàç÷èêè").Range(Cells(Choosen_Client + 1, 5), Cells(Next_Client - 1, 5)))  
'    Choosen_Client_Subdivisions_Count = Sheets("Çàêàç÷èêè").Cells(Choosen_Client + 1, 5).End(xlDown).Row  
   If Sheets("Çàêàç÷èêè").Cells(Choosen_Client + 1, 5).Value <> Empty Then  
       For i = Choosen_Client + 1 To Choosen_Client_Subdivisions_Count  
           ListBox2.AddItem (Sheets("Çàêàç÷èêè").Cells(i, 5))  
       Next i  
   End If  
End Sub  
 
Private Sub ListBox2_AfterUpdate()  
             
   ListBox3.Clear  
     
   Choosen_Subdivision = Sheets("Çàêàç÷èêè").Range("e2:e" & Clients_Last_Row).Find(ListBox2.Value).Row  
   Choosen_Subdivision_Services_Count = Sheets("Çàêàç÷èêè").Cells(Choosen_Subdivision + 1, 6).End(xlDown).Row  
   If Sheets("Çàêàç÷èêè").Cells(Choosen_Subdivision + 1, 6).Value <> Empty Then  
       For i = Choosen_Subdivision + 1 To Choosen_Subdivision_Services_Count  
           ListBox3.AddItem (Sheets("Çàêàç÷èêè").Cells(i, 6))  
       Next i  
   End If  
End Sub  
 
 
Function Count_nonblank(x As Range) As Integer  
   Count_nonblank = x.Cells.Count - WorksheetFunction.CountBlank(x)  
End Function