Wildcard Spreadsheet Name VBA

B

bmkelly

Board Regular
Joined
Mar 26, 2020
Messages
172
Office Version
  1. 365
Platform
  1. Windows
Hello,

I am attempting to take a crack at a former employees VBA code that seems to be a "recorded" macro and would like to finesse it so it has more standardization and more definitive variables. Such as, I would like to take out all the Column Letters and only use Column Headers, I would like to use Spreadsheet Names and not Spreadsheet 15, 16 etc., only because if things were to get added (columns, sheets, etc) that would effect the code to run successfully.

My question for the code I am breaking down below is - There are multiple sheets that have FY22 Transactions, FY23 Transactions, FY24 Transactions etc. (the FY can vary between FY, CY and/or OY and the 22, 23, 24 will always change going forward due to the year) however these sheets are the only ones that have "Transactions" in the worksheet name so is there a code where I can have it wildcard *Transactions* and then do all of the formatting (obviously I will need to fix the column letters into headers and such? You can see the code repeats itself because there are 3 Transactions Sheets with different years so I wasn't sure if this would be a one stop shop to be able to wildcard it and have it due it on all 3 of those wildcard transaction sheets?

VBA Code: 
Sub CSFormat()
'
' CSFormat Macro
'



'Speeds up macro'
 Application.ScreenUpdating = False

'Select the correct worksheet and table then remove filters'
    Worksheets(15).Activate

    Set ListObject = Worksheets(15).ListObjects(1)
    
    ListObject.AutoFilter.ShowAllData
    
'Adjust column widths'
    Columns("E:E").ColumnWidth = 79
    Columns("F:F").ColumnWidth = 36.82
    Columns("G:G").EntireColumn.AutoFit
    Columns("H:H").EntireColumn.AutoFit
    Columns("I:I").ColumnWidth = 58.27
    Columns("J:J").ColumnWidth = 60.36
    Columns("K:K").ColumnWidth = 107.91

'Sort for Q Serial, Transaction Code, Absolute Value, Description'

    ActiveWorkbook.Worksheets(15).ListObjects(1).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(15).ListObjects(1).Sort.SortFields.Add2 Key:=Range(Worksheets(15).ListObjects(1).Name & "[QuarterSerial]"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets(15).ListObjects(1).Sort.SortFields.Add2 Key:=Range(Worksheets(15).ListObjects(1).Name & "[Transaction Code]"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets(15).ListObjects(1).Sort.SortFields.Add2 Key:=Range(Worksheets(15).ListObjects(1).Name & "[Absolute Value]"), SortOn:=xlSortOnValues, Order:= _
        xlDescending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets(15).ListObjects(1).Sort.SortFields.Add2 Key:=Range(Worksheets(15).ListObjects(1).Name & "[Description]"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets(15).ListObjects(1).Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

'Create a column to use the IF function, creating TMX Coverage to be Retired no coverage and All Parts for Missing then delete the unused column'
    Columns("L:L").Select
    Selection.Insert Shift:=xlToRight
    Range(Worksheets(15).ListObjects(1).Name & "[[#Headers],[Column1]]").Select
    ActiveCell.Select
    ActiveCell.FormulaR1C1 = "TriMedx Coverage2"
    ActiveCell.Offset(1, 0).Range(Worksheets(15).ListObjects(1).Name & "[[#Headers],[EquipmentID]]"). _
        Select
    ActiveCell.Formula2R1C1 = _
        "=IFS([@[Transaction Type]]=""Retirement"",""Retired - No Coverage"",[@[TriMedx Coverage]]=""Missing Coverage"",""All Parts & Labor"",[@[TriMedx Coverage]]<>""Missing Coverage"",[@[TriMedx Coverage]])"
    Range("L2").Select
    Selection.AutoFill Destination:=Range(Worksheets(15).ListObjects(1).Name & "[TriMedx Coverage2]")
    Range(Worksheets(15).ListObjects(1).Name & "[TriMedx Coverage2]").Select
    Selection.Copy
    Range("M2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("L:L").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    
'Hide Columns Retired Date, CEID, Proration Date, and Serial'
    Range("Q:Q,P:P").Select
    Range(Worksheets(15).ListObjects(1).Name & "[[#Headers],[Retired Date]]").Activate

    Range("Q:Q,P:P,H:H,G:G").Select
    Range(Worksheets(15).ListObjects(1).Name & "[[#Headers],[CEID]]").Activate
    Selection.EntireColumn.Hidden = True

'Filter and remove all 0 or empty cells from TMX Coverage by filtering the Equipment ID to blanks, then deleting TMX Coverage Values'
    ActiveSheet.ListObjects(1).Range.AutoFilter Field:=1, _
        Criteria1:="="
    Range("L2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Range("L2").Select
    Selection.End(xlToLeft).Select
    Selection.End(xlToLeft).Select
    ActiveSheet.ListObjects(1).Range.AutoFilter Field:=1
    
'Adjust Column Width'
    Columns("L:L").ColumnWidth = 40
    
'Select the correct worksheet and table then remove filters'
    Worksheets(16).Activate
    
    Set ListObject = Worksheets(16).ListObjects(1)
    
    ListObject.AutoFilter.ShowAllData
    
'Adjust column widths'
    Columns("E:E").ColumnWidth = 79
    Columns("F:F").ColumnWidth = 36.82
    Columns("G:G").EntireColumn.AutoFit
    Columns("H:H").EntireColumn.AutoFit
    Columns("I:I").ColumnWidth = 58.27
    Columns("J:J").ColumnWidth = 60.36
    Columns("K:K").ColumnWidth = 107.91

'Sort for Q Serial, Transaction Code, Absolute Value, Description'
    ActiveWorkbook.Worksheets(16).ListObjects(1).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(16).ListObjects(1).Sort.SortFields.Add2 Key:=Range(Worksheets(16).ListObjects(1).Name & "[QuarterSerial]"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets(16).ListObjects(1).Sort.SortFields.Add2 Key:=Range(Worksheets(16).ListObjects(1).Name & "[Transaction Code]"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets(16).ListObjects(1).Sort.SortFields.Add2 Key:=Range(Worksheets(16).ListObjects(1).Name & "[Absolute Value]"), SortOn:=xlSortOnValues, Order:= _
        xlDescending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets(16).ListObjects(1).Sort.SortFields.Add2 Key:=Range(Worksheets(16).ListObjects(1).Name & "[Description]"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets(16).ListObjects(1).Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
'Create a column to use the IF function, creating TMX Coverage to be Retired no coverage and All Parts for Missing then delete the unused column'
    Columns("L:L").Select
    Selection.Insert Shift:=xlToRight
    Range(Worksheets(16).ListObjects(1).Name & "[[#Headers],[Column1]]").Select
    ActiveCell.Select
    ActiveCell.FormulaR1C1 = "TriMedx Coverage2"
    ActiveCell.Offset(1, 0).Range(Worksheets(16).ListObjects(1).Name & "[[#Headers],[EquipmentID]]"). _
        Select
    ActiveCell.Formula2R1C1 = _
        "=IFS([@[Transaction Type]]=""Retirement"",""Retired - No Coverage"",[@[TriMedx Coverage]]=""Missing Coverage"",""All Parts & Labor"",[@[TriMedx Coverage]]<>""Missing Coverage"",[@[TriMedx Coverage]])"
    Range("L2").Select
    Selection.AutoFill Destination:=Range(Worksheets(16).ListObjects(1).Name & "[TriMedx Coverage2]")
    Range(Worksheets(16).ListObjects(1).Name & "[TriMedx Coverage2]").Select
    Selection.Copy
    Range("M2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("L:L").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    
 'Hide Columns Retired Date, CEID, Proration Date, and Serial'
    Range("Q:Q,P:P").Select
    Range(Worksheets(16).ListObjects(1).Name & "[[#Headers],[Retired Date]]").Activate

    Range("Q:Q,P:P,H:H,G:G").Select
    Range(Worksheets(16).ListObjects(1).Name & "[[#Headers],[CEID]]").Activate
    Selection.EntireColumn.Hidden = True
    
'Filter and remove all 0 or empty cells from TMX Coverage by filtering the Equipment ID to blanks, then deleting TMX Coverage Values'
    ActiveSheet.ListObjects(1).Range.AutoFilter Field:=1, _
    Criteria1:="="
    Range("L2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Range("L2").Select
    Selection.End(xlToLeft).Select
    Selection.End(xlToLeft).Select
    ActiveSheet.ListObjects(1).Range.AutoFilter Field:=1
    
'Adjust Column Width'
    Columns("L:L").ColumnWidth = 40
    
'Select the correct worksheet and table then remove filters'
    Worksheets(17).Activate
    
    Set ListObject = Worksheets(17).ListObjects(1)
    
    ListObject.AutoFilter.ShowAllData
    
'Adjust column widths'
    Columns("E:E").ColumnWidth = 79
    Columns("F:F").ColumnWidth = 40
    Columns("G:G").EntireColumn.AutoFit
    Columns("H:H").EntireColumn.AutoFit
    Columns("I:I").ColumnWidth = 58.27
    Columns("J:J").ColumnWidth = 60.36
    Columns("K:K").ColumnWidth = 107.91

'Sort for Q Serial, Transaction Code, Absolute Value, Description'
    ActiveWorkbook.Worksheets(17).ListObjects(1).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(17).ListObjects(1).Sort.SortFields.Add2 Key:=Range(Worksheets(17).ListObjects(1).Name & "[QuarterSerial]"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets(17).ListObjects(1).Sort.SortFields.Add2 Key:=Range(Worksheets(17).ListObjects(1).Name & "[Transaction Code]"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets(17).ListObjects(1).Sort.SortFields.Add2 Key:=Range(Worksheets(17).ListObjects(1).Name & "[Absolute Value]"), SortOn:=xlSortOnValues, Order:= _
        xlDescending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets(17).ListObjects(1).Sort.SortFields.Add2 Key:=Range(Worksheets(17).ListObjects(1).Name & "[Description]"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets(17).ListObjects(1).Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
'Create a column to use the IF function, creating TMX Coverage to be Retired no coverage and All Parts for Missing then delete the unused column'
         Columns("L:L").Select
    Selection.Insert Shift:=xlToRight
    Range(Worksheets(17).ListObjects(1).Name & "[[#Headers],[Column1]]").Select
    ActiveCell.Select
    ActiveCell.FormulaR1C1 = "TriMedx Coverage2"
    ActiveCell.Offset(1, 0).Range(Worksheets(17).ListObjects(1).Name & "[[#Headers],[EquipmentID]]"). _
        Select
    ActiveCell.Formula2R1C1 = _
        "=IFS([@[Transaction Type]]=""Retirement"",""Retired - No Coverage"",[@[TriMedx Coverage]]=""Missing Coverage"",""All Parts & Labor"",[@[TriMedx Coverage]]<>""Missing Coverage"",[@[TriMedx Coverage]])"
    Range("L2").Select
    Selection.AutoFill Destination:=Range(Worksheets(17).ListObjects(1).Name & "[TriMedx Coverage2]")
    Range(Worksheets(17).ListObjects(1).Name & "[TriMedx Coverage2]").Select
    Selection.Copy
    Range("M2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("L:L").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    
'Hide Columns Retired Date, CEID, Proration Date, and Serial'
    Range("Q:Q,P:P").Select
    Range(Worksheets(17).ListObjects(1).Name & "[[#Headers],[Retired Date]]").Activate

    Range("Q:Q,P:P,H:H,G:G").Select
    Range(Worksheets(17).ListObjects(1).Name & "[[#Headers],[CEID]]").Activate
    Selection.EntireColumn.Hidden = True
    
 'Filter and remove all 0 or empty cells from TMX Coverage by filtering the Equipment ID to blanks, then deleting TMX Coverage Values'
    ActiveSheet.ListObjects(1).Range.AutoFilter Field:=1, _
    Criteria1:="="
    Range("L2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Range("L2").Select
    Selection.End(xlToLeft).Select
    Selection.End(xlToLeft).Select
    ActiveSheet.ListObjects(1).Range.AutoFilter Field:=1
    
'Adjust Column Width'
    Columns("L:L").ColumnWidth = 40

'Remove code that speeds up macro'
    Application.ScreenUpdating = True


End Sub
 
Sort by date Sort by votes
There's a lot of detail in these three posts that I probably don't want to get into. But two quick observations:

1. Make sure you qualify your references appropriately. For example, Cells will refer to the ActiveSheet unless you qualify with your sheet name:

VBA Code: 
Sub Test()

    Dim ws As Worksheet
 
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name Like "*Transactions*" Then
            'do things with this sheet, e.g.
            With ws
                .Range("A1") = "Hello!"
                .Cells.EntireColumn.Hidden = False
                'etc etc
            End With
        End If
    Next ws

End Sub

2. Yes, you can have a variable Transaction Table name.

If ws is Worksheets("FY22 Transactions"), say, then:

Code: 
    '...
    With ws
        With .ListObjects(Left(.Name, 4) & "TransactionTable")
            'do stuff with FY22TransactionTable, e.g.
            .Sort ....
        End With
    End With
 
Upvote 0

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
You must log in or register to reply here.

Similar threads

A
  • Solved
VBA - button to sort by date in ascending and descending order
Replies
6
Views
375
Peter_SSs
Peter_SSs
I
  • Question
Macro recorded to sort colm,n A-Z so now need to condense it
Replies
4
Views
79
Micron
M
E
  • Solved
ActiveCell vs Active range search
Replies
3
Views
227
Joe4
Joe4
melodramatic
  • Question
VBA - Sort Table in Alternate Workbook
Replies
1
Views
205
melodramatic
melodramatic
B
  • Question
VBA Error Code
2
Replies
12
Views
946
NoSparks
N

Forum statistics

Threads
1,214,985
Messages
6,122,605
Members
449,089
Latest member
Motoracer88

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