Sub test()
Dim dic As Object, a, i As Long, z As String, myStatus, e, x, y
Dim Status1 As Integer, Status2 As Integer, ii As Integer
Set dic = CreateObject("Scripting.Dictionary")
dic.comparemode = vbTextCompare
myStatus = Array("Released","Low","Med","High","EOL")
a = Workbooks("example1.xls").Sheets("Sheet1").Range("a1").CurrentRegion.Value
For i = 2 To UBound(a,1)
z = Left(a(i,1),InStr(a(i,1),"-")-1)
If Not dic.exists(z) Then
For ii = 0 To UBound(myStatus)
If InStr(1,a(i,2),myStatus(ii),1)>0 Then Status1 = ii + 1 : Exit For
Next
For ii = 0 To UBound(myStatus)
If InStr(1,a(i,3),myStatus(ii),1)>0 Then Status2 = ii + 1 : Exit For
Next
dic.add z, WorksheetFunction.Max(Status1,Status2)
Else
For ii = 0 To UBound(myStatus)
If InStr(1,a(i,2),myStatus(ii),1)>0 Then Statsu1 = ii + 1 : Exit For
Next
For ii = 0 To UBound(myStatus)
If InStr(1,a(i,3),myStatsu(ii),1)>0 Then Status2 = ii + 1 : Exit For
Next
dic(z) = WorksheetFunction.Max(dic(z),Status1,Status2)
End If
Status1 = 0 : Status2 = 0
Next
Erase a : x = dic.keys : y = dic.items : Set dic = Nothing
With Workbooks("example2.xls").Sheets("Sheet1")
For Each r In .Range("b1",.Range("b" & Rows.Count).End(xlUp))
For i = 0 To UBound(x)
If InStr(x(i),r.Value) = 1 Then
r.Offset(,6).Value = myStatus(y(i)-1)
Exit For
End If
Next
Next
End With
End Sub
z = Left(a(i,1),6)
Sub test()
Dim dic As Object, a, i As Long, z As String, myStatus, e, x, y
Dim Status1 As Integer, Status2 As Integer, ii As Integer
Set dic = CreateObject("Scripting.Dictionary")
dic.comparemode = vbTextCompare
myStatus = Array("Released","Low","Med","High","EOL")
a = Workbooks("example1.xls").Sheets("Sheet1").Range("a1").CurrentRegion.Value
For i = 2 To UBound(a,1)
z = Left(a(i,1),6) '<- adjust here if needed
If Not dic.exists(z) Then
For ii = 0 To UBound(myStatus)
If InStr(1,a(i,2),myStatus(ii),1)>0 Then Status1 = ii + 1 : Exit For
Next
For ii = 0 To UBound(myStatus)
If InStr(1,a(i,3),myStatus(ii),1)>0 Then Status2 = ii + 1 : Exit For
Next
dic.add z, WorksheetFunction.Max(Status1,Status2)
Else
For ii = 0 To UBound(myStatus)
If InStr(1,a(i,2),myStatus(ii),1)>0 Then Statsu1 = ii + 1 : Exit For
Next
For ii = 0 To UBound(myStatus)
If InStr(1,a(i,3),myStatsu(ii),1)>0 Then Status2 = ii + 1 : Exit For
Next
dic(z) = WorksheetFunction.Max(dic(z),Status1,Status2)
End If
Status1 = 0 : Status2 = 0
Next
Erase a : x = dic.keys : y = dic.items : Set dic = Nothing
With Workbooks("example2.xls").Sheets("Sheet1")
For Each r In .Range("b1",.Range("b" & Rows.Count).End(xlUp))
For i = 0 To UBound(x)
If InStr(x(i),r.Value) = 1 Then
r.Offset(,6).Value = myStatus(y(i)-1)
Exit For
End If
Next
Next
End With
End Sub