Разбить текст в ячейке на подстроки

Sub Procedure_1()
 
    Dim sCategory(1 To 2) As String
    Dim sFirm(1 To 2) As String
    
    'В массив sResult поместим результат работы.
    Dim sResult(1 To 1, 1 To 4) As String
    
    Dim sString As String
    Dim lLastSpace As Long
    Dim i As Long
    
    'Заносим названия категорий и фирм в массивы.
    sCategory(1) = "Шлейф"
    sCategory(2) = "Категория_2"
    
    'Если названия фирм содержат одинаковые слова в начале,
    'то сначала нужно поместить в массив длинное название.
    'Иначе "Sony" и "Sony Ericsson" будет одно и то же.
    sFirm(1) = "Sony Ericsson"
    sFirm(2) = "Sony"
 
    'Берём текст из ячейки в переменную, чтобы было удобнее код писать.
    sString = Range("A1").Value
 
'Поиск идёт с учётом регистра (больших и маленьких букв).
'Если нужно вести поиск без учёта регистра, то нужно внести изменения в код.
    
'--------------------------------------------------------------------------------------------------
    '1. Берём категорию.
    For i = 1 To UBound(sCategory) Step 1
        'Если искомый текст находится в начале переменной, то будер результат 1.
        If InStr(sString, sCategory(i)) = 1 Then
            'Помещаем данные в массив sResult.
            sResult(1, 1) = sCategory(i)
            'Изменяем переменную, чтобы проще было дальше код писать.
            '+2 включает пробел.
            sString = Mid(sString, Len(sCategory(i)) + 2)
            'Остальные категории не просматриваем.
            Exit For
        End If
    Next i
 
 
'--------------------------------------------------------------------------------------------------
    '2. Берём фирму.
    For i = 1 To UBound(sFirm) Step 1
        'Если искомый текст находится в начале переменной, то будер результат 1.
        If InStr(sString, sFirm(i)) = 1 Then
            'Помещаем данные в массив sResult.
            sResult(1, 2) = sFirm(i)
            'Изменяем переменную, чтобы проще было дальше код писать.
            '+2 включает пробел.
            sString = Mid(sString, Len(sFirm(i)) + 2)
            'Остальные фирмы не просматриваем.
            Exit For
        End If
    Next i
    
    
'--------------------------------------------------------------------------------------------------
    '3. Берём модель и артикул.
    
    'Определяем, где в переменной находится последний пробел.
    lLastSpace = InStrRev(sString, " ")
    
    'Помещаем данные в массив sResult.
    sResult(1, 3) = Left(sString, lLastSpace - 1)
    sResult(1, 4) = Mid(sString, lLastSpace + 1)
 
End Sub