Setting up a Case Select structure using a reference table

[A Guy Named Robby]

I have lots of Case Select scenarios set up. I'm going to have to add a lot more. A greatly condensed sample is below. How can I recreate this scenario using a reference table?

Beginning on row 84 to the end of the data, it's comparing what's in column O (college names) to hundreds/thousands of cases. If it finds a match, it enters a specific digit in column N.

Sub NumberFillIn()
Dim LastRow As Long
Dim i As Long
LastRow = Range("O" & Rows.Count).End(xlUp).Row
For i = 84 To LastRow

Select Case Range("O" & i)

Case "New York University", "NYU", "New York Univ.", "New York Univ"
Range("N" & i) = "1"

Case "Abraham Lincoln University"
Range("N" & i) = "2"

Case "Mississippi College"
Range("N" & i) = "3"

Case "Piedmont College"
Range("N" & i) = "4"

Case "Minnesota State University"
    Select Case Range("P" & i)
    Case "Bemidji"
    Range("N" & i) = "5"
    Case "Moorhead"
    Range("N" & i) = "6"
    Case "St Cloud", "St. Cloud"
    Range("N" & i) = "7"
    Case "Mankato"
    Range("N" & i) = "8"
    End Select

End Sub

 

[Eric W]

Set up a sheet in your workbook named reference. Then build your table there, like this:

	A	B	C
1	Value	Match1	Match2
2	1	New York University	*
3	1	NYU	*
4	1	New York Univ.	*
5	1	New York Univ	*
6	2	Abraham Lincoln University	*
7	3	Mississippi College	*
8	4	Piedmont College	*
9	5	Minnesota State University	Bemidji
10	6	Minnesota State University	Moorhead
11	7	Minnesota State University	St Cloud
12	7	Minnesota State University	St. Cloud
13	8	Minnesota State University	Mankato
14	9	USC	*
15	10	UCLA	*

<colgroup><col style="width: 25pxpx"><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>

Reference​

The asterisk in column C means anything will match.

Then change your VBA to something like this:

Sub NumberFillIn()
Dim LastRow As Long, i As Long
Dim MyOptions As Variant, j As Long, Match1 As String, Match2 As String

    MyOptions = Sheets("Reference").Range("A1:C15").Value
    
    LastRow = Range("O" & Rows.Count).End(xlUp).Row
    
    For i = 84 To LastRow
        
        Match1 = Range("O" & i)
        Match2 = Range("P" & i)
        For j = 2 To UBound(MyOptions)
            If Match1 Like MyOptions(j, 2) And Match2 Like MyOptions(j, 3) Then
                Range("N" & i).Value = MyOptions(j, 1)
                Exit For
            End If
        Next j
                
    Next i
    
End Sub

There are ways to tweak this, but this should give you the basic idea. Let us know if this works for you.

 

[A Guy Named Robby]

Interesting. Thanks for that. It seems simple enough, but I was hoping I'd be able to do something like this, where you could have multiple possible matches in one cell instead of in separate rows. Is there any way to make that work?

	A	B	C
1	Value	Match1	Match2
2	1	New York University, NYU, New York Univ., New York Univ	*

<tbody>
</tbody>

 

[A Guy Named Robby]

Also, I'm going to have this table in a different workbook. What do I need to do to the following line to make it point to a specific file?

MyOptions = Sheets("Reference").Range("A1:C15").Value

 

[Eric W]

OK, set up your table like this:

	A	B	C
1	Value	Match1	Match2
2	1	New York University, NYU, New York Univ., New York Univ	*
3	2	Abraham Lincoln University	*
4	3	Mississippi College	*
5	4	Piedmont College	*
6	5	Minnesota State University	Bemidji
7	6	Minnesota State University	Moorhead
8	7	Minnesota State University	St Cloud, St. Cloud
9	8	Minnesota State University	Mankato
10	9	USC	*
11	10	UCLA	*

<tbody>
</tbody>

Reference​

Then you can use this code:

Sub NumberFillIn()
Dim LastRow As Long, i As Long
Dim MyOptions As Variant, j As Long, Match1 As String, Match2 As String
    
    With Workbooks("Reference.xlsx")
        LastRow = .Sheets("Reference").Cells(Rows.Count, "A").End(xlUp).Row
        MyOptions = .Sheets("Reference").Range("A1:C" & LastRow).Value
    End With
    
    LastRow = Range("O" & Rows.Count).End(xlUp).Row
    
    For i = 84 To LastRow
        
        Match1 = Range("O" & i)
        Match2 = Range("P" & i)
        For j = 2 To UBound(MyOptions)
            If InStr(MyOptions(j, 2), Match1) > 0 And InStr(MyOptions(j, 3), Match2) > 0 Then
                Range("N" & i).Value = MyOptions(j, 1)
                Exit For
            End If
        Next j
                
    Next i
    
End Sub

You can see the line in red that allows you to pull the reference table from another workbook. With the macro coded this way, that workbook must be open when you run this macro. There are more complicated ways to read data from a closed workbook, but it's probably easier to just open it and minimize it.

I used the InStr function instead of the Like function so that you could put the comma delimited variations in a single cell.

Hope this helps!

 

[Eric W]

I got curious and did a bit more research. Here's a way to read from a closed file:

Sub NumberFillIn()
Dim LastRow As Long, i As Long
Dim MyOptions As Variant, j As Long, Match1 As String, Match2 As String
    
    Application.ScreenUpdating = False
    With Worksheets.Add
        .Range("$A$1:$C$1000").FormulaArray = _
        "='C:\Users\username\Documents\[Reference.xlsx]Reference'!$A$1:$C$1000"
        LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        MyOptions = .Range("A1:C" & LastRow).Value
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True
    End With
    
    LastRow = Range("O" & Rows.Count).End(xlUp).Row
    
    For i = 84 To LastRow
        
        Match1 = Range("O" & i)
        Match2 = Range("P" & i)
        For j = 2 To UBound(MyOptions)
            If InStr(MyOptions(j, 2), Match1) > 0 And InStr(MyOptions(j, 3), Match2) > 0 Then
                Range("N" & i).Value = MyOptions(j, 1)
                Exit For
            End If
        Next j
                
    Next i

    Application.ScreenUpdating = True
    
End Sub

It's not too terribly complicated. It requires the full path name of the file. It creates a temporary sheet, pulls the data onto the temporary sheet, then saves the pertinent data to an array, then deletes the temporary sheet. The 1000 in the range would be an upper limit, change it to something meaningful for your data.

Hope this helps!

 

[A Guy Named Robby]

Awesome. Thanks, Eric!

 

[A Guy Named Robby]

Actually, wait. I tried using your code for reading from a closed file. I'm getting this error: Unable to set the FormulaArray property of the Range class

Sub NumberFillIn3()
Dim LastRow As Long, i As Long
Dim MyOptions As Variant, j As Long, Match1 As String, Match2 As String
    
    Application.ScreenUpdating = False
    With Worksheets.Add
        .Range("$A$1:$D$1000").FormulaArray = _
        "='H:\Folder\Folder\hoodlookuptesting.xlsx]Reference'!$A$1:$D$1000"
        LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        MyOptions = .Range("A1:C" & LastRow).Value
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True
    End With
    
    LastRow = Range("O" & Rows.Count).End(xlUp).Row
    
    For i = 84 To LastRow
        
        Match1 = Range("O" & i)
        Match2 = Range("P" & i)
        For j = 2 To UBound(MyOptions)
            If InStr(MyOptions(j, 2), Match1) > 0 And InStr(MyOptions(j, 3), Match2) > 0 Then
                Range("N" & i).Value = MyOptions(j, 1)
                Exit For
            End If
        Next j
                
    Next i
End Sub

 

[Eric W]

You missed a bracket:

.Range("$A$1:$D$1000").FormulaArray = _
        "='H:\Folder\Folder\[hoodlookuptesting.xlsx]Reference'!$A$1:$D$1000"

 

[A Guy Named Robby]

Oh. Whoops. Sorry. I usually catch errors like that. Thanks.