Macro that needs to be more dynamic based on selection

Question

I have this code and i find myself creating 12 times and modules since I have 12 different colleges, each with a unique names.

I would like to make a bit more dynamic, so when I press a specific textbox (I use textbox's and bind to macros instead of buttons) the code captures that and as in Criteria, have tired to use Shapes.Range(Array("DS")).Select but cant figure out how to include that within the Criterial.

Atm I have made 12 modules and within each below code, changed Criteria:= and each macro is bound to each button, but I think it should be possible to have one code, 12 boxes and depending on which box with what name (I have named them all) the code should do the sorting and the filtering.

I do appreciate your guys help and sorry for being so beginner at this..

If anyone wonders what this workbook dose (I have a lot of modules and macros running ofc for different functions) is, importing data, format it, deleting and cleaning a lot of stuff, then making a dynamic table since the source data can vary for day to day, and then based on filtering on colleges, export as a none vba/macro file (I generate a new sheet with the info I want, export that, save that) then mail it out, delete the sheet, clean everything (my woorkbook).

    Sub SortExport_DS()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Sheets.Add(After:=Sheets("PR11_P3")).Name = "R11 (P3)" & " fram t.o.m. " & Format(Now - 1, "YYYY-MM-DD")
    
    Sheets("PR11_P3").Select
    ActiveSheet.ListObjects("PR11_P3_Tabell").Range.AutoFilter Field:=5, _
        Criteria1:="S, Daniel"
    Range("PR11_P3_Tabell[#All]").Select
    Selection.Copy
    
    Sheets(Sheets.Count).Select
    Range("A1").Select
    ActiveSheet.Paste
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("A1").Select
    
    Dim Table As ListObject
    Set Table = ActiveSheet.ListObjects.Add(xlSrcRange, _
    Range("A10").CurrentRegion, , xlYes)
        With Table
            .Name = "PR11_P3_Temp_Tabell"
        End With
    Sheets("PR11_P3").Select
    Application.CutCopyMode = False
    Range("A10").Select

End Sub

Answer 1

Tested and works for me:

Sub SortExportSelected()
    
    Dim txt, ws As Worksheet, wb As Workbook, rVis As Range, wsName As String
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set wb = ActiveWorkbook 'or ThisWorkbook
    
    'get the text from the clicked-on shape
    txt = ActiveSheet.Shapes(Application.Caller).TextFrame2.TextRange.Text
    
    wsName = "R11 (P3)" & " fram t.o.m. " & Format(Now - 1, "YYYY-MM-DD")
    'if a sheet with this name already exists, delete it
    Application.DisplayAlerts = False
    On Error Resume Next 'ignore error if no matched sheet
    ThisWorkbook.Sheets(wsName).Delete
    On Error GoTo 0      'stop ignoring errors
    Application.DisplayAlerts = True
    
    Set ws = wb.Worksheets.Add(After:=Sheets("PR11_P3")) 'get reference to the added sheet
    ws.Name = wsName
    
    With wb.Worksheets("PR11_P3").ListObjects("PR11_P3_Tabell")
         .Range.AutoFilter Field:=5, Criteria1:=txt   'use `txt` for filtering
         .Range.SpecialCells(xlCellTypeVisible).Copy ws.Range("A1")
    End With
    
    With ws.ListObjects.Add(xlSrcRange, ws.Range("A1").CurrentRegion, , xlYes)
            .Range.EntireColumn.AutoFit
            .Name = "PR11_P3_Temp_Tabell"
    End With

    With wb.Worksheets("PR11_P3")
        .Select
        .Range("A10").Select
    End With
    Application.CutCopyMode = False
    
End Sub