Multiple replace vba

Sub database()

Dim arr, arr2
Dim i As Long, j As Long, k As Long, l As Long
Dim txt As String
Range("D2:D1048576").Clear

For i = 2 To Range("C" & Rows.Count).End(xlUp).Row

If Cells(i, 2) <> "" Then
arr = Split(Cells(i, 2).Value, "; ")

ReDim arr2(0 To UBound(arr))
For l = 0 To UBound(arr)
arr2(l) = Split(arr(l), " ")
Next l

For j = 0 To UBound(arr2)

For k = 2 To Range("A" & Rows.Count).End(xlUp).Row

Select Case arr2(j)(0)
Case Is = "s."
    If Cells(k, 1).Value Like "*" & "strawberry" & "*" Then
    If txt = "" Then
    txt = Application.WorksheetFunction.Substitute(Cells(i, 3).Value, arr(j), Cells(k, 1).Value)
    Else
    txt = Application.WorksheetFunction.Substitute(txt, arr(j), Cells(k, 1).Value)
    End If
    Else
    End If
Case Is = "l."
    If Cells(k, 1).Value Like "*" & "light blue" & "*" And arr2(j)(1) = "blue" Then
    If txt = "" Then
    txt = Application.WorksheetFunction.Substitute(Cells(i, 3).Value, arr(j), Cells(k, 1).Value)
    Else
    txt = Application.WorksheetFunction.Substitute(txt, arr(j), Cells(k, 1).Value)
    End If
    Else
    End If
Case Else
    If Cells(k, 1).Value Like "*" & arr2(j)(0) & "*" Then
    If txt = "" Then
    txt = Application.WorksheetFunction.Substitute(Cells(i, 3).Value, arr(j), Cells(k, 1).Value)
    Else
    txt = Application.WorksheetFunction.Substitute(txt, arr(j), Cells(k, 1).Value)
    End If
    Else
    End If
End Select
    

Next k

Next j
If txt = "" Then
Cells(i, 4).Value = Cells(i, 3).Value
Else
Cells(i, 4).Value = txt
End If

txt = ""
Else
Cells(i, 4).Value = Cells(i, 3).Value

End If

Next i

End Sub

This macro returns the intended result for my sample data in the attached file. The code would become more complicated if you had more replacement such as "L. Blue" to "Light Blue" and "Y." to "Yellow". I assume that in your screenshot "Orange 12m" in cell B4 is a typo and it should be "Orange 128m" as in cell C4.