Setting up a Case Select structure using a reference table

A

A Guy Named Robby

New Member
Joined
Oct 19, 2016
Messages
25
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.

Code: 
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
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Sort by date Sort by votes
Set up a sheet in your workbook named reference. Then build your table there, like this:

ABC
ValueMatch1Match2
New York University*
NYU*
New York Univ.*
New York Univ*
Abraham Lincoln University*
Mississippi College*
Piedmont College*
Minnesota State UniversityBemidji
Minnesota State UniversityMoorhead
Minnesota State UniversitySt Cloud
Minnesota State UniversitySt. Cloud
Minnesota State UniversityMankato
USC*
UCLA*

<colgroup><col style="width: 25pxpx"><col><col><col></colgroup><thead>
</thead><tbody>
[TD="align: center"]1[/TD]

[TD="align: center"]2[/TD]
[TD="align: right"]1[/TD]

[TD="align: center"]3[/TD]
[TD="align: right"]1[/TD]

[TD="align: center"]4[/TD]
[TD="align: right"]1[/TD]

[TD="align: center"]5[/TD]
[TD="align: right"]1[/TD]

[TD="align: center"]6[/TD]
[TD="align: right"]2[/TD]

[TD="align: center"]7[/TD]
[TD="align: right"]3[/TD]

[TD="align: center"]8[/TD]
[TD="align: right"]4[/TD]

[TD="align: center"]9[/TD]
[TD="align: right"]5[/TD]

[TD="align: center"]10[/TD]
[TD="align: right"]6[/TD]

[TD="align: center"]11[/TD]
[TD="align: right"]7[/TD]

[TD="align: center"]12[/TD]
[TD="align: right"]7[/TD]

[TD="align: center"]13[/TD]
[TD="align: right"]8[/TD]

[TD="align: center"]14[/TD]
[TD="align: right"]9[/TD]

[TD="align: center"]15[/TD]
[TD="align: right"]10[/TD]

</tbody>
Reference​



The asterisk in column C means anything will match.

Then change your VBA to something like this:

Code: 
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.
 
Upvote 0
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?

ABC
ValueMatch1Match2
New York University, NYU, New York Univ., New York Univ
*

<tbody>
[TD="align: center"]1[/TD]

[TD="align: center"]2[/TD]
[TD="align: right"]1[/TD]

</tbody>
 
Upvote 0
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?

Code: 
MyOptions = Sheets("Reference").Range("A1:C15").Value
 
Upvote 0
OK, set up your table like this:

ABC
ValueMatch1Match2
New York University, NYU, New York Univ., New York Univ*
Abraham Lincoln University*
Mississippi College*
Piedmont College*
Minnesota State UniversityBemidji
Minnesota State UniversityMoorhead
Minnesota State UniversitySt Cloud, St. Cloud
Minnesota State UniversityMankato
USC*
UCLA*

<tbody>
[TD="align: center"]1[/TD]

[TD="align: center"]2[/TD]
[TD="align: right"]1[/TD]

[TD="align: center"]3[/TD]
[TD="align: right"]2[/TD]

[TD="align: center"]4[/TD]
[TD="align: right"]3[/TD]

[TD="align: center"]5[/TD]
[TD="align: right"]4[/TD]

[TD="align: center"]6[/TD]
[TD="align: right"]5[/TD]

[TD="align: center"]7[/TD]
[TD="align: right"]6[/TD]

[TD="align: center"]8[/TD]
[TD="align: right"]7[/TD]

[TD="align: center"]9[/TD]
[TD="align: right"]8[/TD]

[TD="align: center"]10[/TD]
[TD="align: right"]9[/TD]

[TD="align: center"]11[/TD]
[TD="align: right"]10[/TD]

</tbody>
Reference​



Then you can use this code:

Rich (BB 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!
 
Upvote 0
I got curious and did a bit more research. Here's a way to read from a closed file:

Rich (BB code): 
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!
 
Last edited:
Upvote 0
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

Code: 
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
 
Upvote 0
You missed a bracket:

Rich (BB code): 
.Range("$A$1:$D$1000").FormulaArray = _
        "='H:\Folder\Folder\[hoodlookuptesting.xlsx]Reference'!$A$1:$D$1000"
 
Upvote 0
You must log in or register to reply here.

Similar threads

kelly mort
  • Question Question
My smart tweak ended up crashing excel- I need expert advice and fix
2
Replies
12
Views
2K
DanteAmor
DanteAmor
C
  • Question Question
Ton of script in case anyone wants to review, maybe something useful to someone
Replies
0
Views
3K
cizzett
C
G
  • Question Question
Using a value in a table to set a "max length" conditional formatting rule in a cell on another sheet.
Replies
0
Views
643
gazook89
G
J
  • Question Question
Can I Reference Sheet Codenames in VBA instead of the Index?
2
Replies
14
Views
7K
JustJerry2C
J
F
  • Question Question
VBA- error message: Compile Error Invalid Next Control Variable Reference
Replies
6
Views
2K
Greg Truby
Greg Truby

Forum statistics

Threads
1,223,903
Messages
6,175,284
Members
452,630
Latest member
OdubiYouth

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