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
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Sort by date Sort by votes
bmkelly said:
Had a similar issue at our workplace and it turned out to be a permissions issue rather than a coding issue. the file/folder that the code was referencing the individual had restricted access to.
Click to expand...
 
Upvote 0
I think if it was a permissions thing the error message would have said.
Currently we don't know what the error message said,
just that the line highlighted after clicking debug was either line 54, 131 or 208
 
Upvote 0
The code references everything within this one worksheet the individual is trying to run it on and not other files/worksheets. I was thinking permissions too since I could run the macro on his worksheet no problem but he couldn’t etc.

The code is in the individuals personal binary worksheet that is hidden. That’s where we have stored all our macros an individuals will just import the BAS.file.
 
Upvote 0
NoSparks said:
I think if it was a permissions thing the error message would have said.
Currently we don't know what the error message said,
just that the line highlighted after clicking debug was either line 54, 131 or 208
Click to expand...
as for the error message this is what he is receiving

image
 
Upvote 0
NoSparks said:
I think if it was a permissions thing the error message would have said.
Currently we don't know what the error message said,
just that the line highlighted after clicking debug was either line 54, 131 or 208
Click to expand...
ours didnt say permission issue just debugged to the line where the code was trying to access the file
 
Upvote 0
gordsky said:
ours didnt say permission issue just debugged to the line where the code was trying to access the file
Click to expand...
i mean the excel file is open when this code is ran so i know the individual along with everyone else has access to the file.

curious though where in permissions did you look?
 
Upvote 0
we started with the file and looked for hidden / restricted sheets and then worked backwards. We eventually found that the individual had read/write permission rather than full control
 
Upvote 0
gordsky said:
we started with the file and looked for hidden / restricted sheets and then worked backwards. We eventually found that the individual had read/write permission rather than full control
Click to expand...
thanks, i am almost 100% positive thats not the case for us as this individual has access to this file. again the code doesnt open or direct to any other file than the file this individual works in as they can add/edit the document like they always have been.
 
Upvote 0
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 ?
 
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
I
  • Question Question
Receive Automation error when running code & values added to sheet twice
2
Replies
13
Views
424
NoSparks
N
L
  • Question Question
VBA - Run time error '9': subscript out of range
Replies
3
Views
159
RoryA
RoryA

Forum statistics

Threads
1,223,246
Messages
6,170,996
Members
452,373
Latest member
TimReeks

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