x =  1 
Set rngEmp = ActiveSheet.Range("3:3")
Set rngProd = ActiveSheet.Range("A:A")

For Each rngCell In rngEmp

    If rngCell.Value = UserForm4.Label2.Caption Then
    
    n =  0 
    For m =  0  To ListBox2.ListCount -  1 
    
        a =  1 
        For Each rngCellP In rngProd
        
            If rngCellP.Value = UserForm4.ListBox2.Column( 0 , n) Then
            
                Cells(a, x) = "x"
            
            End If
        
        a = a +  1 
        Next rngCellP
        
    n = n +  1 
    Next m
        
    
    End If

x = x +  1 
Next rngCell

x =  1 

'Диапазон сотрудников
Set rngEmp = ActiveSheet.Range("3:3")

'Диапазон продуктов
Set rngProd = ActiveSheet.Range("A:A")


For Each rngCell In rngEmp
'каждую ячейку в диапазоне сотрудников (строка 3) сверяем с надписью лэйбла ID сотрудника
'и как только находим нужного сотрудника переходим к перебору всех выбранных в ListBox2 продуктов
'В данном случае счетчик x - будет соответствовать столбцу, в котором находится нужный сотрудник

    If rngCell.Value = UserForm4.Label2.Caption Then
    
    n =  0 
'проходим по всем продуктам в ListBox2
    For m =  0  To ListBox2.ListCount -  1 
    
    'каждую ячейку из диапазона "A:A" сверяем с названием продукта из списка ListBox2
    'и как только находим продукт, счетчик a будет равен строке в которой находится продукт
        a =  1 
        For Each rngCellP In rngProd
        
            If rngCellP.Value = UserForm4.ListBox2.Column( 0 , n) Then
            
            'Таким образом мы определяем координаты для каждого крестика и ставим его
                Cells(a, x) = "x"
            
            End If
        
        a = a +  1 
        Next rngCellP
        
    n = n +  1  'для ID продукта в списке ListBox2
    Next m
        
    
    End If

x = x +  1 
Next rngCell