VBA to match multiple changing criteria

[ipon70]

I have a problem and arrays and lookups are just bogging down so bad its not usable.

First Criteria: Sheet6 needs to match from C2 to C2500, to a list on Sheet8 column C from $C$2:$C$150000
Second Criteria: Sheet6 needs to match fixed $D$1 to a list on Sheet8 column B from $B$2:$B$150000

Then the first criteria stays the same and the second moves over to $E$1 to a list on sheet8 column B from $B$2:$B$150000.

Basically what its doing is lookup up a student, then seeing if they have had a class, then returning that class to D2, then next student D3 and so on. Then column E becomes the next class the student needs to be matched to, and so on for about 50-60 classes.

I have tried an array, with index match and a lookup and once I add a second lookup it just bogs down so bad, so I am thinking VBA might be a solution.

Hopefully this makes sense, please let me know if you need more information.

 

[Legacy 143009]

Can you please provide some sample data? And desired end result?

 

[ipon70]

Can you please provide some sample data? And desired end result?

The first picture is the results page, I need it return "Prac-Class" below the words Prac-Class,if it finds the student has done that class from the list on the second(picture).
Then move to the next student id and match the Prac-Class and if not found just leave it blank and move on. So on down the list for about a 1000 students.
Where it says 1. Prac-Class 2. Pre-Prac Class is what feeds the headers on D and E and so on.

	Class Monitored	Student ID	Prac-Class	Pre-Prac Class
1​	Prac-Class	652065489​
2​	Pre-Prac Class	349733031​
3​		712123680​
4​		245514572​
5​		489790298​
6​		496269931​
7​		583330795​
8​		278085187​
9​		54059133​
10​		210605131​

	CLASS	Student ID
1​	Prac-Class	774817044​
2​	Prac-Class	774817044​
3​	Prac-Class	654526831​
4​	Prac-Class	654526831​
5​	Prac-Class	654526831​
6​	Pre-Prac Class	654526831​
7​	Pre-Prac Class	654526831​
8​	Pre-Prac Class	236618233​
9​	Pre-Prac Class	909524977​
10​	Prac-Class	909524977​
11​	Prac-Class	909524977​
12​	Prac-Class	909524977​
13​	Prac-Class	921441059​
14​	Prac-Class	921441059​
15​	Prac-Class	349352457​
16​	Prac-Class	172739472​
17​	Pre-Prac Class	656401571​
18​	Pre-Prac Class	207585276​
19​	Pre-Prac Class	207585276​
20​	Pre-Prac Class	341958085​

 

[Legacy 143009]

you said you have 60 classes. Do you have class names until column BK?

 

[ipon70]

you said you have 60 classes. Do you have class names until column BK?

It literally can change week to week, each quarter, and other factors. There may be an emergency drop of a class that has to get added and taught in a two week period. So yeah it could be that far out, or farther, by the end of the year when you mop up the people that didn't get in early in the year, or were out sick. Currently there are 23 classes being monitored to give you an idea.

 

[Legacy 143009]

It is still unclear to me. I hope this is what you are looking for. Initial setup:

Sub test()
  Dim lRow As Long, lCol As Long, r As Long
  lRow = Worksheets("Sheet8").Cells(Rows.Count, 3).End(xlUp).Row
  lCol = Worksheets("Sheet6").Cells(1, Columns.Count).End(xlToLeft).Column
  With Worksheets("Sheet6")
  r = 2
  For i = 2 To lRow
    If .Cells(r - 1, 3).Value <> Worksheets("Sheet8").Cells(i, 3).Value Then
      For c = 4 To lCol
        If .Cells(1, c).Value = Worksheets("Sheet8").Cells(i, 2).Value Then
          .Cells(r, 2).Value = Worksheets("Sheet8").Cells(i, 2).Value
          r = r + 1
        End If
      Next
    End If
  Next
  End With
End Sub

Result:

 

[ipon70]

It is still unclear to me. I hope this is what you are looking for. Initial setup:
View attachment 84898View attachment 84896

Sub test()
  Dim lRow As Long, lCol As Long, r As Long
  lRow = Worksheets("Sheet8").Cells(Rows.Count, 3).End(xlUp).Row
  lCol = Worksheets("Sheet6").Cells(1, Columns.Count).End(xlToLeft).Column
  With Worksheets("Sheet6")
  r = 2
  For i = 2 To lRow
    If .Cells(r - 1, 3).Value <> Worksheets("Sheet8").Cells(i, 3).Value Then
      For c = 4 To lCol
        If .Cells(1, c).Value = Worksheets("Sheet8").Cells(i, 2).Value Then
          .Cells(r, 2).Value = Worksheets("Sheet8").Cells(i, 2).Value
          r = r + 1
        End If
      Next
    End If
  Next
  End With
End Sub

Result:
View attachment 84900

Ok, thank you so much, I will try this when I can get back on this project. Thank you again and I will follow up.

 

[ipon70]

Ok, thank you so much, I will try this when I can get back on this project. Thank you again and I will follow up.

Ok I got a chance to throw it in and it says Run-time error '9' "Subscript is out of range"

But I think I can help you out a little more here

	Class Monitored	Student ID	Prac-Class (If they have had it)	Pre-Prac Class (If they have had it)
1​	Prac-Class	652065489​	Prac-Class	Pre-Prac Class
2​	Pre-Prac Class	349733031​		Pre-Prac Class
3​		712123680​		Pre-Prac Class
4​		245514572​	Prac-Class	Pre-Prac Class
5​		489790298​
6​		496269931​	Prac-Class	Pre-Prac Class
7​		583330795​	Prac-Class	Pre-Prac Class
8​		278085187​		Pre-Prac Class
9​		54059133​
10​		210605131​	Prac-Class	Pre-Prac Class

The left side in RED is what feeds the headers across in red. I added the "if they have had it" for visual help here.
So the search would happen as you have it listed on sheet 8, but needs to return the results in the RED columns if they have had it. Or if its easier, a 0 (zero) if they haven't and a 1 if they have. Anything that can return a yes or no status without grinding the machine to a halt. Hope that helps

 

[Legacy 143009]

I am sorry. This is the best I can do. Maybe you should wait for another help.

WeTransfer - Send Large Files & Share Photos Online - Up to 2GB Free

WeTransfer is the simplest way to send your files around the world

we.tl

Sub test()
  Dim lRow As Long, lCol As Long, r As Long, rng As Range
  With Worksheets("Sheet8")
  Set rng = .Range("C2:C" & .Cells(Rows.Count, 3).End(xlUp).Row)
  End With
  With Worksheets("Sheet6")
  lRow = .Cells(Rows.Count, 3).End(xlUp).Row
  lCol = .Cells(1, Columns.Count).End(xlToLeft).Column
  For r = 2 To lRow
    For Each cll In rng
      If .Cells(r, 3).Value = cll.Value Then
        For c = 4 To lCol
          If .Cells(1, c).Value = cll.Offset(, -1).Value Then
            .Cells(r, c).Value = 1
          End If
        Next
      End If
    Next
  Next
  End With
End Sub

 

[ipon70]

I am sorry. This is the best I can do. Maybe you should wait for another help.

WeTransfer - Send Large Files & Share Photos Online - Up to 2GB Free

WeTransfer is the simplest way to send your files around the world

we.tl

Sub test()
  Dim lRow As Long, lCol As Long, r As Long, rng As Range
  With Worksheets("Sheet8")
  Set rng = .Range("C2:C" & .Cells(Rows.Count, 3).End(xlUp).Row)
  End With
  With Worksheets("Sheet6")
  lRow = .Cells(Rows.Count, 3).End(xlUp).Row
  lCol = .Cells(1, Columns.Count).End(xlToLeft).Column
  For r = 2 To lRow
    For Each cll In rng
      If .Cells(r, 3).Value = cll.Value Then
        For c = 4 To lCol
          If .Cells(1, c).Value = cll.Offset(, -1).Value Then
            .Cells(r, c).Value = 1
          End If
        Next
      End If
    Next
  Next
  End With
End Sub

Ok, thank you so much for your help....I really do appreciate it, and I might be able to tweek it myself if this doesn't work.

Thanks again.