New to excel VBA : Need guidance

[xtinct]

Example1

Example2

after filtering for example, all of "PA" eg. "PA1-AA" "PA2-AA" "PA3-AA" using VBA, how do i compare their risk status and copy the highest risk status in Example1 to the respective Example2 Status colum?

Thanks in advance.

 

[jindon]

try this

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

 

[xtinct]

error over

End With

it says End With without With

 

[jindon]

Yup

I missed out one Next

do you want to try again?

 

[xtinct]

thank you very much.. now it is working..

 

[xtinct]

btw.. what does this line mean?

r.Offset(, 6).Value = myStatus(y(i) - 1)

 

[jindon]

While you are in VB Editor
1) [View]-[LocalWindow]
2) Click somewhere on the code
3) as you hit F8, code will execute line by line

then you can see all the variables in the local window to check how it works...

 

[xtinct]

what i dont understand is that it works perfectly on the example.. but when i try it on my actual data, it ran until the 6th product in the Product Name of Example2.xls and stop and shows an error..

 

[jindon]

Thas't why I asked the layout of example2.xls

 

[xtinct]

maybe i can send u my actual data? but do you have any suggestion on how i can send them to you? is there any file host website that i can use to upload the file?

 

[jindon]

After your PM
You need to adjust the line of

z = Left(a(i,1),6)

If you have example2.xls code have more/less than 1st 6 characters of example1.xls

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