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
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
Sort by date Sort by votes
Good luck with this! There's a lot of tidying that can be done.

Here's one way you could do it:

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.
            ws.Range("A1") = "Hello!"
        End If
    Next ws

End Sub

Another way, if you could always count on your Transactions sheets being sandwiched between SheetA and SheetB would be to loop from:

Sheet("SheetA").Index+1 to Sheet("SheetB").Index-1

although it would be safer to use codenames rather than sheet names.
 
Upvote 0
StephenCrump said:
Good luck with this! There's a lot of tidying that can be done.

Here's one way you could do it:

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.
            ws.Range("A1") = "Hello!"
        End If
    Next ws

End Sub

Another way, if you could always count on your Transactions sheets being sandwiched between SheetA and SheetB would be to loop from:

Sheet("SheetA").Index+1 to Sheet("SheetB").Index-1

although it would be safer to use codenames rather than sheet names.
Click to expand...
Okay awesome! Yes, I am still learning VBA but much rather try to type/hard code a lot of my VBA than record a macro due to complications it can cause (although complications can occur hard coding things as well but less likely) so I have been going macro by macro trying to improve them and this just had my mind rolling ?

I will give your wildcard sub out and clean things up more and will keep you posted on outcome! Thank you.
 
Upvote 0
You can also remove a lot of your Select.Selection lines, eg from this
VBA Code: 
Range(Worksheets(15).ListObjects(1).Name & "[TriMedx Coverage2]").Select
    Selection.Copy
    Range("M2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
To this
VBA Code: 
Range("M2").value=Range(Worksheets(15).ListObjects(1).Name & "[TriMedx Coverage2]").value
 
Upvote 0
Michael M said:
You can also remove a lot of your Select.Selection lines, eg from this
VBA Code: 
Range(Worksheets(15).ListObjects(1).Name & "[TriMedx Coverage2]").Select
    Selection.Copy
    Range("M2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
To this
VBA Code: 
Range("M2").value=Range(Worksheets(15).ListObjects(1).Name & "[TriMedx Coverage2]").value
Click to expand...
Okay! Thanks, I know I am trying to eliminate any sort of cell select or column select without the code looking for the header name first and then proceeding with the code that way if someone adds a column and it effects where M2 was then the whole code will be off. But I will take you’re suggestion and try to work with what I have in my other macros that read column headers and go from there! I am sure I will be back with more questions once I actually dive into tackle this tidying up!
 
Upvote 0
StephenCrump said:
Good luck with this! There's a lot of tidying that can be done.

Here's one way you could do it:

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.
            ws.Range("A1") = "Hello!"
        End If
    Next ws

End Sub

Another way, if you could always count on your Transactions sheets being sandwiched between SheetA and SheetB would be to loop from:

Sheet("SheetA").Index+1 to Sheet("SheetB").Index-1

although it would be safer to use codenames rather than sheet names.
Click to expand...
I seem to be getting stuck trying this....

So I am wanting the macro to find any of the sheets that have the word "Transaction" in them (in this particular example there are 3), once it finds the first Transaction Sheet I would then like for the code to do the following:

1. Unhide all columns and remove all filters from the current Transaction Sheet it is on
2. Find these column headers "Customer", "Department", "CEID", "Serial", "Manufacturer", "Model", "Description" and autofit the column width
3. Custom Sort the Sheet with these fields: QuarterSerial (Ascending), Transaction Code (Ascending), Absolute Value (Descending), and Description (Ascending)
4. Find Column Header "Transaction Type", if a cell in this column is "Retirement" then in Column Header of "TriMedx Coverage" it needs to say "Retired - No Coverage".
5. Find Column Header "TriMedx Coverage", if a cell in this column is "Missing Coverage" then replace with "All Parts & Labor"
6. Find these column headers "CEID", "Serial", "Retired Date" and "Proration Date" and Hide Columns
7. Rinse and Repeat with the other 2 *Transaction* Sheets
 
Upvote 0
Can you please post the code you're using?

When you say "stuck", what specifically is or isn't happening with your code that you'd like help with?

Can the code rely on finding the various column headers in a particular row?
 
Upvote 0
StephenCrump said:
Can you please post the code you're using?

When you say "stuck", what specifically is or isn't happening with your code that you'd like help with?

Can the code rely on finding the various column headers in a particular row?
Click to expand...
Mentally stuck lol

So this is the code I just created yesterday but this is for a "regular template" which only has one transaction sheet thats called "Transactions". However we have a newer updated template that contains multiple transaction sheets with different accounting years that will always change but the one common factor is they all have the word *Transaction* in the sheet name.

VBA Code: 
Sub RegularCS()

Application.ScreenUpdating = False

Worksheets("Transactions").Activate
    ActiveSheet.AutoFilterMode = False
        With Cells
            .EntireColumn.Hidden = False
            .EntireRow.Hidden = False
        End With
        
Range("TransactionTable[[#Headers],[Customer]:[Description]]").EntireColumn.AutoFit

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

Worksheets("Transactions").Range("TransactionTable").AutoFilter Field:=19, Criteria1:="<>0", Operator:=xlFilterValues

Dim oLo As ListObject, l As Long, note As String, note2 As String
    Set oLo = Sheets("Transactions").ListObjects("TransactionTable")
        With oLo
    For l = 1 To .ListRows.Count

note = "Retired - No Coverage"
        If .ListColumns("Transaction Type").DataBodyRange(l, 1).Value = "Retirement" Then
            .ListColumns("TriMedx Coverage").DataBodyRange(l, 1).Value = note
        End If

note = "All Parts & Labor "
        If .ListColumns("TriMedx Coverage").DataBodyRange(l, 1).Value = "Missing Coverage" Then
            .ListColumns("TriMedx Coverage").DataBodyRange(l, 1).Value = note
        End If
        
    Next l
    
    End With

Dim LastColumn As Long

    LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
        For i = 1 To LastColumn
    If Cells(1, i).Value = "CEID" Or Cells(1, i).Value = "Serial" Or Cells(1, i).Value = "Retired Date" Or Cells(1, i).Value = "Proration Date" Then Columns(i).Hidden = True
        Next

Worksheets("Budget Adds").Visible = False

Application.ScreenUpdating = True

End Sub

This code is a work in progress but does mostly what I would like for it to do, I just need to somehow incorporate this code into the newer templates with the wildcard *Transaction* as sheet name
 
Upvote 0
StephenCrump said:
Can you please post the code you're using?

When you say "stuck", what specifically is or isn't happening with your code that you'd like help with?

Can the code rely on finding the various column headers in a particular row?
Click to expand...
Here is my attempt at adding in your wildcard code with what i would want the code to do for each of the *Transactions* sheets

VBA Code: 
Sub CSFormat()

Application.ScreenUpdating = False

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets
    If ws.Name Like "*Transactions*" Then
    ActiveSheet.ShowAllData
  On Error GoTo 0
        With Cells
            .EntireColumn.Hidden = False
            .EntireRow.Hidden = False
        End With
        
Range("TransactionTable[[#Headers],[Customer]:[Description]]").EntireColumn.AutoFit

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

Dim oLo As ListObject, l As Long, note As String, note2 As String
    Set oLo = Sheets("*Transactions*").ListObjects("*TransactionTable*")
        With oLo
    For l = 1 To .ListRows.Count

note = "Retired - No Coverage"
        If .ListColumns("Transaction Type").DataBodyRange(l, 1).Value = "Retirement" Then
            .ListColumns("TriMedx Coverage").DataBodyRange(l, 1).Value = note
        End If

note = "All Parts & Labor"
        If .ListColumns("TriMedx Coverage").DataBodyRange(l, 1).Value = "Missing Coverage" Then
            .ListColumns("TriMedx Coverage").DataBodyRange(l, 1).Value = note
        End If
        
        Next l
    
    End With
    
'Worksheets("Transactions").Range("TransactionTable").AutoFilter Field:=19, Criteria1:="<>0", Operator:=xlFilterValues'

Dim LastColumn As Long

    LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
        For i = 1 To LastColumn
    If UCase(Cells(1, i)) = "CEID" Or UCase(Cells(1, i)) = "SERIAL" Or UCase(Cells(1, i)) = "RETIRED DATE" Or UCase(Cells(1, i)) = "PRORATION DATE" Then Columns(i).Hidden = True
        Next
    End If
      
Application.ScreenUpdating = True

    Next

End Sub
 
Upvote 0
I guess I run into a few issues when it comes to wildcard *

So here is a screenshot of the 3 sheets I would like to run a macro thru (note - it wont always be FY22, FY23, FY24 - it could be CY22, CY23, CY24 or the years can even change) so the only character that is the same across all 3 sheets is the word "Transactions"

1645030622648.png


Once it finds the first Transactions sheet I would like for it to show all data (remove filters) and unhide all columns and rows.

VBA Code: 
ActiveSheet.ShowAllData
  On Error GoTo 0
        With Cells
            .EntireColumn.Hidden = False
            .Entir

Then I would like for the code to use the TransactionTable as my range (next tricky party - depending on which Accounting Year Transaction Sheet we are in depends on the title of the TransactionTable name. For example if I am in the FY22 Transactions Sheet my table range will then be "FY22 TransactionTable" so I would like to see if a wildcard is an option here as well) and Autofit certain columns and then custom sort using this code
VBA Code: 
Range("TransactionTable[[#Headers],[Customer]:[Description]]").EntireColumn.AutoFit

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

Then I would like the code to look in the Transaction Type Column for Retirements and then make the Coverage Column state "Retired - No Coverage" and then if Coverage column states Missing Coverage it needs to change to All Parts & Labor.

VBA Code: 
Dim oLo As ListObject, l As Long, note As String, note2 As String
    Set oLo = Sheets("Transactions").ListObjects("TransactionTable")
        With oLo
    For l = 1 To .ListRows.Count

note = "Retired - No Coverage"
        If .ListColumns("Transaction Type").DataBodyRange(l, 1).Value = "Retirement" Then
            .ListColumns("TriMedx Coverage").DataBodyRange(l, 1).Value = note
        End If

note = "All Parts & Labor"
        If .ListColumns("TriMedx Coverage").DataBodyRange(l, 1).Value = "Missing Coverage" Then
            .ListColumns("TriMedx Coverage").DataBodyRange(l, 1).Value = note
        End If
        
        Next l
    
    End With

Then last I would like the code to hide these columns

VBA Code: 
Dim LastColumn As Long

    LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
        For i = 1 To LastColumn
    If UCase(Cells(1, i)) = "CEID" Or UCase(Cells(1, i)) = "SERIAL" Or UCase(Cells(1, i)) = "RETIRED DATE" Or UCase(Cells(1, i)) = "PRORATION DATE" Then Columns(i).Hidden = True
        Next
    End If
      
Application.ScreenUpdating = True

Then go to the next *Transactions* sheet and rinse and repeat
 
Upvote 0
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
1K
Peter_SSs
Peter_SSs
E
  • Solved
A little VBA/Macro code adjustment
Replies
3
Views
262
rollis13
rollis13
I
  • Question Question
Macro recorded to sort colm,n A-Z so now need to condense it
Replies
4
Views
355
Micron
M
T
  • Solved
Can I sort a table by applying columns in a different order to the sort request?
Replies
5
Views
174
TheRedCardinal
T
E
  • Solved
ActiveCell vs Active range search
Replies
3
Views
436
Joe4
Joe4

Forum statistics

Threads
1,223,231
Messages
6,170,885
Members
452,364
Latest member
springate

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