Need help shortening vba code - Compile error - procedure too large

[mssbass]

I have several lines of VBA code that help filter my data by certain criteria - any ideas to shorten my code?

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim ws As Worksheet
Dim sTableName As String
sTableName = "T_Data"
Dim loTable As ListObject
Set ws = Sheets("Data")
Set loTable = ws.ListObjects(sTableName)

If Target.Range.Address = "$D$3" Then
On Error Resume Next
ws.ShowAllData
loTable.Range.AutoFilter Field:=62, Criteria1:="<>Custom Staffing"
loTable.Range.AutoFilter Field:=55, Criteria1:="PASTSOC"
ws.Activate
Else
If Target.Range.Address = "$D$4" Then
On Error Resume Next
ws.ShowAllData
loTable.Range.AutoFilter Field:=61, Criteria1:="MI THH Staffing"
loTable.Range.AutoFilter Field:=55, Criteria1:="PASTSOC"
ws.Activate
Else
If Target.Range.Address = "$D$5" Then
On Error Resume Next
ws.ShowAllData
loTable.Range.AutoFilter Field:=52, Criteria1:="DME"
loTable.Range.AutoFilter Field:=55, Criteria1:="PASTSOC"
loTable.Range.AutoFilter Field:=62, Criteria1:="<>Custom Staffing"
ws.Activate
Else
If Target.Range.Address = "$D$6" Then
On Error Resume Next
ws.ShowAllData
loTable.Range.AutoFilter Field:=49, Criteria1:="Enteral"
loTable.Range.AutoFilter Field:=55, Criteria1:="PASTSOC"
loTable.Range.AutoFilter Field:=62, Criteria1:="<>Custom Staffing"
ws.Activate
Else
If Target.Range.Address = "$D$7" Then........

 

[johnnyL]

The following will get rid of a few lines and also get rid of all the 'If/else/if' stuff:

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
'
    Dim ws          As Worksheet
    Dim sTableName  As String
    Dim loTable     As ListObject
'
    sTableName = "T_Data"
    Set ws = Sheets("Data")
    Set loTable = ws.ListObjects(sTableName)
'
    Select Case Target.Range.Address
        Case "$D$3"
            On Error Resume Next
'
            ws.ShowAllData
            loTable.Range.AutoFilter Field:=62, Criteria1:="<>Custom Staffing"
            loTable.Range.AutoFilter Field:=55, Criteria1:="PASTSOC"
            ws.Activate
'
        Case "$D$4"
            ws.ShowAllData
            loTable.Range.AutoFilter Field:=61, Criteria1:="MI THH Staffing"
            loTable.Range.AutoFilter Field:=55, Criteria1:="PASTSOC"
            ws.Activate
'
        Case "$D$5"
            ws.ShowAllData
            loTable.Range.AutoFilter Field:=52, Criteria1:="DME"
            loTable.Range.AutoFilter Field:=55, Criteria1:="PASTSOC"
            loTable.Range.AutoFilter Field:=62, Criteria1:="<>Custom Staffing"
            ws.Activate
'
        Case "$D$6"
            ws.ShowAllData
            loTable.Range.AutoFilter Field:=49, Criteria1:="Enteral"
            loTable.Range.AutoFilter Field:=55, Criteria1:="PASTSOC"
            loTable.Range.AutoFilter Field:=62, Criteria1:="<>Custom Staffing"
            ws.Activate
'
' .........
'
    End Select

 

[Fluff]

Another option

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
   Dim ws As Worksheet
   Dim sTableName As String
   Dim loTable As ListObject
   Dim Ary As Variant
   Dim i As Long
  
   sTableName = "T_Data"
   Set ws = Sheets("Data")
   Set loTable = ws.ListObjects(sTableName)
  
   Select Case Target.Range.Address
      Case "$D$3": Ary = Array(62, "<>Custom Staffing", 55, "PASTSOC")
      Case "$D$4": Ary = Array(61, "MI THH Staffing", 55, "PASTSOC")
      Case "$D$5": Ary = Array(52, "DME", 55, "PASTSOC", 62, "<>Custom Staffing")
      Case "$D$6": Ary = Array(49, "Enteral", 55, "PASTSOC", 62, "<>Custom Staffing")
   End Select
   ws.Activate
   loTable.Range.AutoFilter
   For i = 0 To UBound(Ary) Step 2
      loTable.Range.AutoFilter Ary(i), Ary(i + 1)
   Next i
End Sub

 

[johnnyL]

Doesn't smell right to me @Fluff.

 

[Fluff]

In what way?

 

[johnnyL]

Post no longer needed

 

[Fluff]

You're quite right, comes from copy/pasting & not checking properly.
I have corrected the code in post#3

 

[mssbass]

Case "D$6" should be 49, not 52

You're right - fixing those