CODEWITHSUNDEEP
vbaexcel
Adam Smith
Adam Smith

Reputation: 105

Excel VBA create embedded macro with external macro

I have a macro file I use to edit and format a hundred Excel files a week that are then sent out. I am looking to add some more involved functionality to the files that are sent out.

Each of the files sent out will need to have code similar to:

Option Explicit

Sub DropDown4_Change()
    With ThisWorkbook.Sheets("ExampleData").Shapes("Drop Down 4").ControlFormat
        Select Case .List(.Value)
            Case "Value1": SelectValue1
            Case "Value2": SelectValue2
            Case "Value3": SelectValue3
            Case "Value4": SelectValue4
            Case "Value5": SelectValue5
            Case "Value6": SelectValue6
            Case "Value7": SelectValue7
            Case "Value8": SelectValue8
        End Select
    End With
End Sub

Sub SelectValue1()
    ActiveSheet.ListObjects("Table4").Range.AutoFilter
    ActiveSheet.ListObjects("Table4").Range.AutoFilter Field:=2, Criteria1:="<>"
End Sub

Sub SelectValue2()
    ActiveSheet.ListObjects("Table4").Range.AutoFilter
    ActiveSheet.ListObjects("Table4").Range.AutoFilter Field:=3, Criteria1:="<>"
End Sub

Sub SelectValue3()
    ActiveSheet.ListObjects("Table4").Range.AutoFilter
    ActiveSheet.ListObjects("Table4").Range.AutoFilter Field:=4, Criteria1:="<>"
End Sub

Sub SelectValue4()
    ActiveSheet.ListObjects("Table4").Range.AutoFilter
    ActiveSheet.ListObjects("Table4").Range.AutoFilter Field:=5, Criteria1:="<>"
End Sub

Sub SelectValue5()
    ActiveSheet.ListObjects("Table4").Range.AutoFilter
    ActiveSheet.ListObjects("Table4").Range.AutoFilter Field:=6, Criteria1:="<>"
End Sub

Sub SelectValue6()
    ActiveSheet.ListObjects("Table4").Range.AutoFilter
    ActiveSheet.ListObjects("Table4").Range.AutoFilter Field:=7, Criteria1:="<>"
End Sub

Sub SelectValue7()
    ActiveSheet.ListObjects("Table4").Range.AutoFilter
    ActiveSheet.ListObjects("Table4").Range.AutoFilter Field:=8, Criteria1:="<>"
End Sub

Sub SelectValue8()
    ActiveSheet.ListObjects("Table4").Range.AutoFilter
    ActiveSheet.ListObjects("Table4").Range.AutoFilter Field:=9, Criteria1:="<>"
End Sub

It's basic filtering based on a combobox selection. What code do I need in my external macro to have it write this code within each Excel file it is run on? Is this possible?

Upvotes: 3

Views: 164

Answers (2)

user3598756
user3598756

Reputation: 29421

a further trimmed version

Sub DropDown4_Change()
    Dim myVal As Long

    With ThisWorkbook.Sheets("ExampleData")
        With .Shapes("Drop Down 4").ControlFormat
            myVal = CLng(Replace(.list(.Value), "Value", "")) + 1
        End With
        .ListObjects("Table4").Range.AutoFilter
        .ListObjects("Table4").Range.AutoFilter Field:=myVal, Criteria1:="<>"
    End With
End Sub

a super-trimmed version

Sub DropDown4_Change()
    With ThisWorkbook.Sheets("ExampleData")
        .ListObjects("Table4").Range.AutoFilter
        .ListObjects("Table4").Range.AutoFilter Field:=CLng(Replace(.Shapes("Drop Down 4").ControlFormat.list(.Shapes("Drop Down 4").ControlFormat.Value), "Value", "")) + 1, Criteria1:="<>"
    End With
End Sub

Upvotes: 1

BruceWayne
BruceWayne

Reputation: 23285

Just a note, unless I'm missing something, you can greatly reduce the size of that code with a small tweak:

Option Explicit

Sub DropDown4_Change()
    Dim fieldVal As Long

    With ThisWorkbook.Sheets("ExampleData").Shapes("Drop Down 4").ControlFormat
        Select Case .List(.Value)
            Case "Value1": fieldVal = 2
            Case "Value2": fieldVal = 3
            Case "Value3": fieldVal = 4
            Case "Value4": fieldVal = 5
            Case "Value5": fieldVal = 6
            Case "Value6": fieldVal = 7
            Case "Value7": fieldVal = 8
            Case "Value8": fieldVal = 9
        End Select
    End With
    Call SelectValue(fieldVal)
End Sub

Sub SelectValue(myVal As Long)
    ActiveSheet.ListObjects("Table4").Range.AutoFilter
    ActiveSheet.ListObjects("Table4").Range.AutoFilter Field:=myVal, Criteria1:="<>"
End Sub

Upvotes: 3

Related Questions