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]

So you haved tested the code?

 

[xtinct]

yes i have tested the codes.. but how do i check for status for every product in "Product Name"? and how to make sure the Status go into the correct rows according to the product row?

for example

i have

PA
PB
PC

how to compare them one after the other?

and after i got the Status, how to put them into correct rows?

such as

PA - highest -----> Example2.xls PA Status
PB - highest -----> Example2.xls PB Status
etc..

Since PA in Example1.xls might have diff row no. as PA in Example2

 

[jindon]

I'm assuming that you have actually tested the previous code and happy with the results.
And the left most sheet in each workbook has same format as you posted.
I don't follow your code since it is only confusing.

Sub test()
Dim a, result(), i As Long, z As String, n As Long, ws As Workbook
a = ThisWorkbook.Sheets(1).Range("a1").CurrentRegion.Resize(,2).Value
ReDim result(1 To UBound(a,1), 1 To 2)
With CreateObject("Scripting.Dictionary")
     .CompareMode = vbTextCompare
     For i = 2 To UBound(a,1)
          If Not IsEmpty(a(i,1)) Then
               z = Left(a(i,1),2)
               If Not .exists(z) Then
                   n = n + 1
                   result(n,1) = z
                   result(n,2) = a(i,2)
               Else
                   x = .item(z)
                   If InStr(1,result(x,2),"High",vbTextCompare) = 0 Then
                         If InStr(1,a(i,2),"High",vbTextCompare) > 0 Then
                              result(x,2) = a(i,2)
                         ElseIf InStr(1, a(i,2), "Med",vbTextCompare) > 0 Then
                              result(x,2) = a(i,2)
                         End If
                   End If
                End If
          End If
     Next
     For Each ws In Workbooks
          If wb.Name <> ThisWorkbook.Name Then
               With wb.Sheets(1)
                    For Each r In .Range("a2",.Range("a" & Rows.Count).End(xlUp))
                         If .exists(r.Value) Then r.Offset(,1) = .item(r.Value)
                    Next
               End With
          End If
     Next
End With
End Sub

 

[xtinct]

i try to run the new code u gave but was unable to run it.. think u might have forgot to declare a variable or something..

the error occurs at this line on the alphabet Each "r"

For Each r In .Range("a2",.Range("a2 & Rows.Count).End(xlUp))

 

[jindon]

That line should read

For Each r In .Range("a2",.Range("a" & Rows.Count).End(xlUp))

 

[xtinct]

i have done some amendments to the code

Sub test()
Dim a, result(), i As Long, z As String, n As Long, ws As Workbook
a = ThisWorkbook.Sheets(1).Range("a1").CurrentRegion.Resize(, 2).Value
ReDim result(1 To UBound(a, 1), 1 To 2)
With CreateObject("Scripting.Dictionary")
     .CompareMode = vbTextCompare
     For i = 2 To UBound(a, 1)
          If Not IsEmpty(a(i, 1)) Then
               z = Left(a(i, 1), 2)
               If Not .exists(z) Then
                   n = n + 1
                   result(n, 1) = z
                   result(n, 2) = a(i, 2)
               Else
                   x = .Item(z)
                   If InStr(1, result(x, 2), "High", vbTextCompare) = 0 Then
                         If InStr(1, a(i, 2), "High", vbTextCompare) > 0 Then
                              result(x, 2) = a(i, 2)
                         ElseIf InStr(1, a(i, 2), "Med", vbTextCompare) > 0 Then
                              result(x, 2) = a(i, 2)
                         End If
                   End If
                End If
          End If
     Next
     For Each ws In Workbooks
          If ws.Name <> ThisWorkbook.Name Then
               With ws.Sheets(1)
                    For Each r In .Range("a2", .Range("a" & Rows.Count).End(xlUp))
                         If .exists(r.Value) Then r.Offset(, 1) = .Item(r.Value)
                    Next
               End With
          End If
     Next
End With
End Sub

and now it is stuck at

If .exists(r.Value) Then r.Offset(, 1) = .Item(r.Value)

btw.. what is "r"? is it supposed to be a variable?

 

[jindon]

Yup
r is a variable(Range)
How about this one

Make sure that each sheet has list of Criteria such as
PA
PB
PC
on column A

Sub test()
Dim a, result(), i As Long, z As String, n As Long, ws As Workbook, r As Range
a = ThisWorkbook.Sheets(1).Range("a1").CurrentRegion.Resize(,2).Value
ReDim result(1 To UBound(a,1), 1 To 2)
With CreateObject("Scripting.Dictionary")
     .CompareMode = vbTextCompare
     For i = 2 To UBound(a,1)
          If Not IsEmpty(a(i,1)) Then
               z = Left(a(i,1),2)
               If Not .exists(z) Then
                   n = n + 1
                   result(n,1) = z
                   result(n,2) = a(i,2)
               Else
                   x = .item(z)
                   If InStr(1,result(x,2),"High",vbTextCompare) = 0 Then
                         If InStr(1,a(i,2),"High",vbTextCompare) > 0 Then
                              result(x,2) = a(i,2)
                         ElseIf InStr(1, a(i,2), "Med",vbTextCompare) > 0 Then
                              result(x,2) = a(i,2)
                         End If
                   End If
                End If
          End If
     Next
     For Each ws In Workbooks
          If wb.Name <> ThisWorkbook.Name Then
               With wb.Sheets(1)
                    For Each r In .Range("a2",.Range("a" & Rows.Count).End(xlUp))
                         If .exists(r.Value) Then r.Offset(,1) = result(.item(r.Value,2)
                    Next
               End With
          End If
     Next
End With
End Sub

[/quote]

 

[xtinct]

This are my 2 files.. when i copy your code into them, there are errors and i cant run it..

Example2
http://www.yousendit.com/transfer.php?action=download&ufid=F1D914100E918BD9

Example1
http://www.yousendit.com/transfer.php?action=download&ufid=74767BCC387331C2

 

[jindon]

Check PM

 

[jindon]

Reg your PM
try

Sub sample()
Dim ws1 As Worksheet, ws2 As Worksheet, r As Range, c As Range, ff As String, myStatus As String
Set ws1 = Workbooks("Example1.xls").Sheets("Sheet1")
Set ws2 = Workbooks("Example2.xls").Sheets("Sheet1")

For Each r In ws2.Range("b2",ws2.Range("b" & Rows.Count).End(xlUp))
      Set c = ws1.Columns("a").Find(r.Value,,,xlPart)
      If Not c Is Nothing Then
           ff = c.Address
           Do
                 Select Case c.Offset(,1).Value
                      Case "*High" : myStatus = "Risk-High" : Exit Do
                      Case "*Med" : myStatus = "Risk-Med"
                      Case "*Low"
                          If myStatus <> "Risk-High" And myStatus <> "Risk-Med" Then
                              myStatus = "Risk-Low"
                          End If
                 End Select
                 Set c = ws1.columns("a").FindNext(c)
           Loop Until ff = c.Address
           r.Offset(,6).Value = myStatus : myStatus = Empty
      Else
           MsgBox r.Value & " is not exist"
      End If
Next
Set ws1 = Nothing
Set ws2 = Nothing
End Sub