New to excel VBA : Need guidance

X

xtinct

New Member
Joined
Sep 11, 2006
Messages
48
example1.jpg

Example1
example2.jpg

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.
 
Sort by date Sort by votes

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
Can you just quickly test the code?
Code: 
Sub test()
Dim dic As Object, a, i As Long, z As String, myStatus, e
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,2)
    z = Left(a(i,1),6)
    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
         If InStr(1,a(i,3),myStatus(ii),1)>0 Then Status2 = ii + 1
       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
         If InStr(1,a(i,3),myStatsu(ii),1)>0 Then Status2 = ii + 1
       Next
       dic(z) = WorksheetFunction.Max(dic(z),Status1,Status2)
    End If
    Status1 = 0 : Status2 = 0
Next
Erase a
With Workbooks("example2.xls").Sheets("Sheet1")
    For Each r In .Range("b1",.Range("b" & Rows.Count).End(xlUp))
       z = Left(r.Value,6)
       If dic.exists(z) Then
           If dic(z) > 0 Then r.Offset(,6).Value = myStatus(dic(z)-1)
       End If
    Next
End With
Set dic = Nothing
End Sub
 
Upvote 0
hi, i tried running the code and it says there is a syntax error at

Code: 
myStatus = Array("Released","Low",Med","High","EOL")
 
Upvote 0
hi, i tried running the code and it says there is a syntax error at

Code: 
myStatus = Array("Released","Low",Med","High","EOL")
Click to expand...

Should

MyStatus = Array("Released","Low","Med","High","EOL")
 
Upvote 0
ok.. corrected the error.. but after running to code, the result i get in the Status column of Example2.xls only shows "EOL"
 
Upvote 0
How about
Code: 
Sub test()
Dim dic As Object, a, i As Long, z As String, myStatus, e
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,2)
    z = Left(a(i,1),6)
    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
With Workbooks("example2.xls").Sheets("Sheet1")
    For Each r In .Range("b1",.Range("b" & Rows.Count).End(xlUp))
       z = Left(r.Value,6)
       If dic.exists(z) Then
           If dic(z) > 0 Then r.Offset(,6).Value = myStatus(dic(z)-1)
       End If
    Next
End With
Set dic = Nothing
End Sub
 
Upvote 0
hi, sorry for the late reply.. was busy just now.. tried the new code but still the same.. the "Status" column of Example2.xls shows only EOL
 
Upvote 0
Can you just run the code and return with the values displayed?
Code: 
Sub test()
Dim dic As Object, a, i As Long, z As String, myStatus, e
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,2)
    z = Left(a(i,1),6)
    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
With Workbooks("example1.xls").Sheets("Sheet1")
   .Range("g1").Resize(dic.count) = Application.Transpose(dic.keys)
   .Range("h1").Resize(dic.Count)= Application.Transpose(dic.items)
End With
Set dic = Nothing
End Sub
 
Upvote 0
after running the lastest code, nothing happens in Example2.xls

Example1.xls result is as follow..

newExample1.jpg
 
Upvote 0
Of course!
your data is totally differenct from the sample posted.
Code: 
Sub test()
Dim dic As Object, a, i As Long, z As String, myStatus, e
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,2)
    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
With Workbooks("example2.xls").Sheets("Sheet1")
    For Each r In .Range("b1",.Range("b" & Rows.Count).End(xlUp))
       z = Left(r.Value,6)
       If dic.exists(z) Then
           If dic(z) > 0 Then r.Offset(,6).Value = myStatus(dic(z)-1)
       End If
    Next
End With
Set dic = Nothing
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
Complex Move data from two spreadsheets with similar data in different columns to a specific column in an existing spreadsheet(Sheet 3)
Replies
0
Views
138
JMC57
J
I
  • Question
Move multiple rows from one table to another using conditional trigger
Replies
2
Views
490
ItsNursinTime
I
A
  • Solved
Comparing two excel files for matching / mismatching rows (long text strings - match() wont work
Replies
4
Views
598
ahaye
A
A
  • Question
VBA to Split Data From an Existing Table into Another Single Worksheet with Header for Each Section
Replies
1
Views
221
John_w
J
A
  • Question
VBA macro to format excel worksheet.
Replies
1
Views
1K
HaHoBe
HaHoBe

Forum statistics

Threads
1,215,467
Messages
6,124,984
Members
449,201
Latest member
Lunzwe73

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top