Multiple Criteria From Differing Rows

Re: Multiple Criteria From Differing Rows

Patty,

As you can see there are many ways to solve problems in Excel.

I replaced the code that was failing on your PC with a FOr .. Next loop. A little slower code, but if it works that's OK.

See Attached.

Bill

Re: Multiple Criteria From Differing Rows

Quote from psindelar

Kris,
Thank you for your VBA test. It ran in the spreadsheet, but there were many entries that it missed. The first Student ID in H2 also took Business Tech II and is in H57. The code did not pick up that student. Is there an adjustment to this code that I can make?

Patty

Replace

[vba]If x = 3 Then: Cells(i, 11) = 3: Exit For[/vba]

with

[vba]If x >= 3 Then: Cells(i, 11) = 3: Exit For[/vba]

HTH

Re: Multiple Criterion From Differing Rows

Quote from psindelar

Thank you for your help!

I work at a school and am getting a report ready for the state of Illinois. I have 2,438 rows of student information. What I am attempting to do is add a "3" if a student took both semesters of a specified course. Semester 1 is listed in one column and row by the number "1." Semester 2 is listed in a separate column and row by the number "2." The unique qualifier is the student ID. I need to have Excel match student ID with both the semester 1 and semester 2 as well as the course. I have attached a sampling of the file I am working on. In FY column, I need a "3" next to those matching student IDs that took the same course for both semester I and 2.

Sub test()
Dim a, i As Long
With Range("a1").CurrentRegion.Resize(,11)
     a = .Value
     With CreateObject("Scripting.Dictionary")
          For i = 2 To UBound(a,1)
               If Not .exists(a(i,8)) Then
                     .add a(i,1), i
               Else
                    a(i,11) = 3 : a(.item(a(i,8)) = 3
              End If
         Next
     End With
    .Value = a
End With
End Sub

Re: Multiple Criteria From Differing Rows

Hi jindon,

I get a syntax error on this code

a(i,11) = 3 : a(.item(a(i,8)) = 3

bill

Re: Multiple Criteria From Differing Rows

Quote from Bill Rockenbach

Hi jindon,

I get a syntax error on this code

Code

a(i,11) = 3 : a(.item(a(i,8)) = 3

bill

Display More

OOps

that should be

a(i,11) = 3 : a(.item(a(i,8)),[B]11[/B]) = 3

Re: Multiple Criteria From Differing Rows

Now get a run time error 457
This key already associated with an element of this collection

Re: Multiple Criteria From Differing Rows

Sorry msg for jindon's code

Now get a run time error 457
This key already associated with an element of this collection

Bill

Re: Multiple Criteria From Differing Rows

Quote from Bill Rockenbach

Sorry msg for jindon's code

Now get a run time error 457
This key already associated with an element of this collection

Bill

Bill

Can you post your code and specify the line that you are getting an error?

Re: Multiple Criteria From Differing Rows

msg Krishnakumar,

Your code is

1. Matcing some unrelated courses. A student may have taken course I of one subject and Course 2 of an unrelated subject and your program matches them.

2. For some reason its putting a 3 indicator for some students who took only one course.

Bill

Re: Multiple Criteria From Differing Rows

Bill

If you have multiple Subejcts with multiple Courses, how can we identify the defference?

Is it only from the last "I"s ?

Re: Multiple Criteria From Differing Rows

Sub test()
Dim a, i As Long, dic As Object, x As String, y As String
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("sheet1").Range("a1").CurrentRegion.Resize(,11)
     a = .Value
     With CreateObject("VBScript.RegExp")
          .Pattern = "I+$"
          For i = 2 To UBound(a,1)
               x = Trim$(.execute(a(i,3))(0))
               y = Trim$(.replace(a(i,3),""))
               If Not dic.exists(a(i,8) & y) Then
                    dic.add a(i,8) & y, Array(x,i)
               Else
                    If dic(a(i,8) & y)(0) <> x Then
                         a(i,11) = 3 : a(dic(a(i,8) & y)(1),11) = 3
               End If
          Next
     End With
     .Value = a
End With
Set dic = Nothing
End Sub

.

Re: Multiple Criteria From Differing Rows

[vba]Sub kTest_v1()
Dim a, b, w(), i As Long, dic As Object, j As Long, k As Integer, x, y, z
Set dic = CreateObject("scripting.dictionary")
With Sheets("sheet1")
a = .[a1].CurrentRegion.Resize(, 11)
Range(.[b2], .[b65536].End(xlUp)).Replace What:=" I*", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
b = .[a1].CurrentRegion.Resize(, 11)
End With
For i = 2 To UBound(a, 1)
If Not IsEmpty(a(i, 8)) Then

x = b(i, 2) & "#" & a(i,
If Not dic.exists(x) Then
ReDim w(1 To 3): w(1) = b(i, 2): w(2) = a(i, 8): w(3) = a(i, 9) + a(i, 10)
dic.Add x, w
Else
w = dic(x)
w(1) = dic(x)(1): w(2) = dic(x)(2): w(3) = dic(x)(3) + a(i, 9) + a(i, 10)
dic(x) = w
End If
End If
Next: z = dic.items: Set dic = Nothing
For i = 2 To UBound(a, 1)
Cells(i, 2) = a(i, 2)
For j = 0 To UBound(z)
If a(i, = z(j)(1) And b(i, 2) = z(j)(2) Then
If z(j)(3) >= 3 Then: Cells(i, 11) = 3: Exit For
End If
Next
Next
End Sub[/vba]

Re: Multiple Criteria From Differing Rows

Missed an End If

Sub test()
Dim a, i As Long, dic As Object, x As String, y As String
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("sheet1").Range("a1").CurrentRegion.Resize(,11)
     a = .Value
     With CreateObject("VBScript.RegExp")
          .Pattern = "I+$"
          For i = 2 To UBound(a,1)
               x = Trim$(.execute(a(i,3))(0))
               y = Trim$(.replace(a(i,3),""))
               If Not dic.exists(a(i,8) & y) Then
                    dic.add a(i,8) & y, Array(x,i)
               Else
                    If dic(a(i,8) & y)(0) <> x Then
                         a(i,11) = 3 : a(dic(a(i,8) & y)(1),11) = 3
                    End If
               End If
          Next
     End With
     .Value = a
End With
Set dic = Nothing
End Sub

Re: Multiple Criteria From Differing Rows

Hi all,

The data is setup in cadenced order of subsets of courses (1 and 2):

course1a 1
course1b 2
course2a 1
course2b 2
course3a 1
course3b 2
.
.
.

One can not compare a student to the total universe but only the course subset as that student may be taking other courses in the table.

Krishnakumar,
No courses are now marked with a three with your latest code.

jindon
Your latest code now has a runtime error 5, Invalid procedure call or argument. (I’m running xl2000 is there a version conflict?)

Patty,
Did you try my latest code?

Bill

Re: Multiple Criteria From Differing Rows

Patty,
Finally!! Glad I could help.

As Andy pointed out on another thread the Find statement in my original code that failed had a syntax error. This error did not show up in my version of xl2000.

I have attached that code with the correct syntax. If its not too much trouble would you please test this on your xl2003 and let me know if it works ok.

Bill

Re: Multiple Criteria From Differing Rows

Thanks PAtty,
If you would please try one more file. If this doesn't work we can stop testing

Thanks
Bill

Re: Multiple Criteria From Differing Rows

Patty,
Thanks for doing the testing.

The problem was the Find Method statement syntax error. I had xlValue and should have been xlValues. xl2000 ran OK but xl2003 didn't like the syntax error. Thanks Andy for pointing this out.

In regard to learning VBA. I am detail, text book oriented. Never took an VBA class. However, had classes and years of experience in various other programming languages.

For you I would suggest a course in any programming language to understand the basics of program flow. If your detail oriented, after that text books. Only you know your orientation to self taught text book vs. taken courses.

Thanks for your help
And thanks everyone for the patience with this long so long thread.

Bill (over and out)