VBA Error Code

B

bmkelly

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

My team and I have launched some macro's to help incorporate automation to our processes. However one employee keeps getting an error at this spot in the code every single time. Me and another employee who are trying to troubleshoot have both ran the macro in this individuals workbook and neither him or I had an errors, we also have had this individual run the macro in a different workbook and he would still get the same error, any ideas why this would occur to this individual?

This is where the code errors out:
VBA Code: 
ActiveCell.Formula2R1C1 = _
        "=IFS([@[Transaction Type]]=""Retirement"",""Retired - No Coverage"",[@[TriMedx Coverage]]=""Missing Coverage"",""All Parts & Labor"",[@[TriMedx Coverage]]<>""Missing Coverage"",[@[TriMedx Coverage]])"


This is the entire code:
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
Le
NoSparks said:
That Run-time error would lead me to believe the formula is wrong, but you say it works for 2 out of 3 of you.
If you change Worksheets(15), Worksheets(16) and Worksheets(17) to the actual names of the worksheets does #3 still get the same error ?
Click to expand...
I will get back with you when I am able to have the individual try that out. I did not write this code however so this is something that I am going to have to improve as well.
 
Upvote 0

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
NoSparks said:
That Run-time error would lead me to believe the formula is wrong, but you say it works for 2 out of 3 of you.
If you change Worksheets(15), Worksheets(16) and Worksheets(17) to the actual names of the worksheets does #3 still get the same error ?
Click to expand...
I still am struggling with this code since it deals with wildcards due to their being multiple "Transactions" Sheets along with "TransactionTable" depending on the sheet name.

However I took our regular template that just contains one transaction sheet and wrote this code for the individual and it was able to run on his PC so I know its not a permissions deal.... However like I stated it gets a bit out of my realm with the level of detail that has to be put into the new template that contains multiple worksheets with the word "Transactions" and then the next issue then deals with multiple "TransactionTable" so I have to somehow figure out how to wildcard Transactions make that sheet active and run thru the code and wildcard TransactionTable and then go to the next Transaction sheet and run thru the same code etc....

1645036021367.png


1645035851059.png


VBA Code: 
Sub CSFormat()
Application.ScreenUpdating = False

Worksheets("Transactions").Activate
On Error Resume Next
    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

Application.ScreenUpdating = True
    
End Sub
 
Upvote 0
It appears you've now abandoned the original question and created a duplicate of this one where,
in post #2 StephenCrump provided code to loop thought the worksheets so you would only deal with the ones that fit the wildcard request.
 
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
2K
Peter_SSs
Peter_SSs
E
  • Solved
A little VBA/Macro code adjustment
Replies
3
Views
293
rollis13
rollis13
N
  • Question Question
ActiveX Option Button to sort Data in another sheet and update conbobox
2 3
Replies
22
Views
344
NUC_N_FUTS2
N
I
  • Question Question
Macro recorded to sort colm,n A-Z so now need to condense it
Replies
4
Views
378
Micron
M
I
  • Question Question
Receive Automation error when running code & values added to sheet twice
2
Replies
13
Views
447
NoSparks
N

Forum statistics

Threads
1,224,823
Messages
6,181,185
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

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