Hello,
I have this code:
And am wondering how to go about autofitting based off Column Headers. I would like to AutoFit Column Headers 'Customer' to 'Description'. This issue I run into is the macro I have runs thru 3 "Transaction" Sheets that have different names.
However I do have this code in one of my templates that only contains one Transaction Sheet and you can see it references the TransactionTable. Ideally, it would be nice to do the same but since there are 3 TransactionTables that vary in their names it makes it a bit difficult for me to figure out how to go about this AutoFit.
'Adjust Column Widths"
Range("TransactionTable[[#Headers],[Customer]:[Description]]").EntireColumn.AutoFit
Here is my entire VBA Code:
I have this code:
VBA Code:
'Adjust column widths'
Columns("E:E").ColumnWidth = 80
Columns("F:F").ColumnWidth = 40
Columns("G:G").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
Columns("I:I").ColumnWidth = 60
Columns("J:J").ColumnWidth = 60
Columns("K:K").ColumnWidth = 110And am wondering how to go about autofitting based off Column Headers. I would like to AutoFit Column Headers 'Customer' to 'Description'. This issue I run into is the macro I have runs thru 3 "Transaction" Sheets that have different names.
However I do have this code in one of my templates that only contains one Transaction Sheet and you can see it references the TransactionTable. Ideally, it would be nice to do the same but since there are 3 TransactionTables that vary in their names it makes it a bit difficult for me to figure out how to go about this AutoFit.
'Adjust Column Widths"
Range("TransactionTable[[#Headers],[Customer]:[Description]]").EntireColumn.AutoFit
Here is my entire VBA Code:
VBA Code:
Option Explicit
Sub AscCSFormat()
'Start Stopwatch'
Dim startTime As Single
startTime = Timer
Dim ws As Worksheet
Dim oLo As ListObject
Dim transCol As Long, trimedCol As Long, LastColumn As Long, aspCol As Long, transdteCol As Long, i As Long
Dim visRng As Range, f As Range, hdr As Range, r As Range
Dim note1 As String, note2 As String, cell As String
Application.Calculation = xlManual
Application.ScreenUpdating = False
Application.EnableEvents = False
For Each ws In ActiveWorkbook.Worksheets
If ws.Name Like "*Transactions*" Then
With ws
.Activate
On Error Resume Next
ws.ShowAllData
On Error GoTo 0
.Columns.Hidden = False
.Rows.Hidden = False
'Set Table'
Set oLo = ws.ListObjects(1)
End With
'Custom Sort'
With oLo.Sort
.SortFields.Clear
.SortFields.Add2 Key:=Range(oLo.Name & "[QuarterSerial]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add2 Key:=Range(oLo.Name & "[Transaction Code]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add2 Key:=Range(oLo.Name & "[Absolute Value]"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
.SortFields.Add2 Key:=Range(oLo.Name & "[Description]"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Change Verbage'
note1 = "Retired - No Coverage"
note2 = "All Parts & Labor"
'Columns Used for Filtering'
transCol = oLo.ListColumns("Transaction Type").Range.Column
trimedCol = oLo.ListColumns("TriMedx Coverage").Range.Column
aspCol = oLo.ListColumns("Annual Service Price").Range.Column
transdteCol = oLo.ListColumns("Transaction Date").Range.Column
With oLo.Range
.AutoFilter Field:=transCol, Criteria1:="Retirement"
Set visRng = oLo.ListColumns(trimedCol).DataBodyRange.SpecialCells(xlCellTypeVisible)
If Not visRng Is Nothing Then
visRng.Value = note1
Set visRng = Nothing
End If
.AutoFilter
.AutoFilter Field:=trimedCol, Criteria1:="Missing Coverage"
On Error Resume Next ' running a second time, this errors
Set visRng = oLo.ListColumns(trimedCol).DataBodyRange.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not visRng Is Nothing Then
visRng.Value = note2
Set visRng = Nothing
End If
.AutoFilter
'Hide $0 Transactions in Annual Service Price Column'
.AutoFilter Field:=aspCol, Criteria1:="$-"
.AutoFilter Field:=transdteCol, Criteria1:="<>" & "*Total*"
On Error Resume Next
Set visRng = oLo.ListColumns(aspCol).DataBodyRange.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
.AutoFilter ' remove filter
If Not visRng Is Nothing Then
visRng.EntireRow.Hidden = True
Set visRng = Nothing
End If
End With
'Adjust Column Widths"
Columns("E:E").ColumnWidth = 80
Columns("F:F").ColumnWidth = 40
Columns("G:G").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
Columns("I:I").ColumnWidth = 60
Columns("J:J").ColumnWidth = 60
Columns("K:K").ColumnWidth = 110
'Hide Columns'
LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To LastColumn
If Trim(UCase(Cells(1, i))) = "CEID" Or Trim(UCase(Cells(1, i))) = "SERIAL" Or Trim(UCase(Cells(1, i))) = "RETIRED DATE" Or Trim(UCase(Cells(1, i))) = "PRORATION DATE" Then Columns(i).Hidden = True
Next
'Remove Page Breaks'
ActiveSheet.ResetAllPageBreaks
'Set Page Breaks'
Set hdr = Rows(1).Find("Transaction Date", , xlValues, xlWhole, , , False)
If Not hdr Is Nothing Then
Set r = Columns(hdr.Column)
Set f = r.Find("*Total*", , xlValues, xlPart, , , False)
If Not f Is Nothing Then
cell = f.Address
Do
f.Offset(1).PageBreak = xlPageBreakManual
Set f = r.FindNext(f)
Loop While Not f Is Nothing And f.Address <> cell
End If
End If
'Add Filter Option'
oLo.HeaderRowRange.AutoFilter
'Select A1'
ActiveSheet.Range("A1").Select
Application.Goto ActiveSheet.Range("A1"), True
End If
Next ws
Application.Goto Sheets("Cover Page").Range("O1")
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
Debug.Print "Time to complete = " & Timer - startTime & " seconds."
End Sub
