I have an excel sheet that gives me run-time
Error '438'. Object doesn't support this property or method. It has been working fine until now. Any help is much appreciated.
When I press debug this part of the code : Selection.OnAction = "ADDOTHERMATL"
is highlighted in yellow.
Dim QtyTblRange As String
QtyTblRange = Worksheets("Errors").UsedRange.Offset(MaxRowNum, 0).Resize(2, (n + 2)).Address
Worksheets("Errors").ListObjects.Add(xlSrcRange, Worksheets("Errors").Range(QtyTblRange), , xlYes).Name = "QtyErrors"
MaxRow = Worksheets("JobNumConvert").Range("C" & Worksheets("JobNumConvert").Cells(Worksheets("JobNumConvert").Rows.Count, "C").End(xlUp).Row).Address
Sheets("JobNumConvert").Range("C3:" & MaxRow).Copy
MaxRow = Worksheets("Errors").Range("A" & Worksheets("Errors").Cells(Worksheets("Errors").Rows.Count, "A").End(xlUp).Row).Address
Sheets("Errors").Range(MaxRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Worksheets("Errors").ListObjects("QtyErrors").Range.AutoFilter Field:=(n + 1), Criteria1:="<>0", Operator:=xlAnd
Worksheets("Errors").Cells.EntireColumn.AutoFit
ActiveWorkbook.Worksheets("Syteline - Job Materials").ListObjects("JobAggregateTable").Sort.SortFields.Clear
Worksheets("Syteline - Job Materials").ListObjects(1).AutoFilter.ShowAllData
Worksheets("Errors").Buttons.Add(350, 10, 200, 25).Select
***Selection.OnAction = "ADDOTHERMATL"***
Selection.Characters.Text = "Add Other Matl to Entry Sheet"
With Selection.Characters(Start:=1, Length:=29).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Worksheets("Errors").Range("A4").FormulaR1C1 = "BOM Errors: Results in this Table indicate that Syteline's standard BOM expects a material value where the HRB results reported none."
Worksheets("Errors").Range("A4").Font.Bold = True
Worksheets("Errors").Range(MaxRow).Offset(-2, 0).FormulaR1C1 = "Qty Errors: Results in this Table are filtered to display instances where the HRB material totals and the Entry Sheet Material totals differ."
Worksheets("Errors").Range(MaxRow).Offset(-2, 0).Font.Bold = True
Worksheets("Errors").Range("A1").Activate
End Sub
Sub ADDOTHERMATL()
n = Worksheets("Errors").ListObjects("QtyErrors").ListColumns("Other Matl").Index
Worksheets("Errors").ListObjects("QtyErrors").Range.AutoFilter Field:=(n), Criteria1:="<>", Operator:=xlAnd
MaxRowNum = Worksheets("Entry Sheet").Range("B" & Worksheets("Entry Sheet").Cells(Rows.Count, "B").End(xlUp).Row).Row + 1
Dim OtherRows
With Worksheets("Errors").ListObjects("QtyErrors")
For Each Line In .Range.SpecialCells(xlCellTypeVisible).Areas
OtherRows = OtherRows + Line.Rows.Count
Next
End With
If OtherRows <= 1 Then
Worksheets("Errors").ListObjects("QtyErrors").Sort.SortFields.Clear
Worksheets("Errors").ListObjects("QtyErrors").AutoFilter.ShowAllData
Worksheets("Errors").ListObjects("QtyErrors").Range.AutoFilter Field:=(n - 1), Criteria1:="<>0", Operator:=xlAnd
MsgBox "No Other Material(s) selected.": Exit Sub
End If
OtherRows = (OtherRows + MaxRowNum - 2)
Sheets("Entry Sheet").Range("B" & MaxRowNum & ":B" & OtherRows).FormulaR1C1 = 10
Sheets("Errors").Range("QtyErrors[Other Matl]").SpecialCells(xlCellTypeVisible).Copy
Sheets("Entry Sheet").Range("C" & MaxRowNum & ":C" & OtherRows).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("Errors").Range("QtyErrors[HRB Other Qty]").SpecialCells(xlCellTypeVisible).Copy
Sheets("Entry Sheet").Range("E" & MaxRowNum & ":E" & OtherRows).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("Entry Sheet").Range("F" & MaxRowNum & ":F" & OtherRows).FormulaR1C1 = "LBS"
Sheets("Entry Sheet").Range("H" & MaxRowNum & ":H" & OtherRows).FormulaR1C1 = "MAIN"
Sheets("Entry Sheet").Range("I" & MaxRowNum & ":I" & OtherRows).FormulaR1C1 = "9999999"
Sheets("Entry Sheet").Range("J" & MaxRowNum & ":J" & OtherRows).FormulaR1C1 = "Data, Entry"
Sheets("Entry Sheet").Range("K" & MaxRowNum & ":K" & OtherRows).FormulaR1C1 = "Pending"
Sheets("Entry Sheet").Range("L" & MaxRowNum & ":L" & OtherRows).FormulaR1C1 = 1
Sheets("Entry Sheet").Range("M" & MaxRowNum & ":M" & OtherRows).FormulaR1C1 = 1
Sheets("Entry Sheet").Range("N" & MaxRowNum & ":N" & OtherRows).FormulaR1C1 = "= TODAY()-1"
Sheets("Errors").Range("QtyErrors[Pallet]").SpecialCells(xlCellTypeVisible).Copy
Sheets("Entry Sheet").Range("Q" & MaxRowNum & ":Q" & OtherRows).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("Entry Sheet").Range("O" & MaxRowNum & ":O" & OtherRows).FormulaR1C1 = "="" "" & LEFT(RC[2],5)"
Sheets("Entry Sheet").Range("P" & MaxRowNum & ":P" & OtherRows).FormulaR1C1 = "=SUBSTITUTE(RIGHT(RC[1],2), 0, """")"
Sheets("Entry Sheet").Range("R" & MaxRowNum & ":R" & OtherRows).FormulaR1C1 = "1"
Sheets("Entry Sheet").Range("G" & MaxRowNum & ":G" & OtherRows).FormulaR1C1 = "=IF(LEFT(INDEX(Summary!C[-6],MATCH('Entry Sheet'!RC[10],Summary!C[4],0)),1)=""P"",""Poplar - STOCK"",""STOCK"")"
With Sheets("Entry Sheet").UsedRange
.Copy
.PasteSpecial xlPasteValues
End With
Worksheets("Entry Sheet").Range("A" & MaxRowNum & ":R" & OtherRows).Style = "40% - Accent5"
Worksheets("Entry Sheet").Range("A1:R" & OtherRows).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17), Header:=xlYes
Worksheets("Errors").ListObjects("QtyErrors").Sort.SortFields.Clear
Worksheets("Errors").ListObjects("QtyErrors").AutoFilter.ShowAllData
Worksheets("Errors").ListObjects("QtyErrors").Range.AutoFilter Field:=(n - 1), Criteria1:="<>0", Operator:=xlAnd
OtherRows = (OtherRows - MaxRowNum) + 1
Worksheets("Errors").Activate
MsgBox "" & OtherRows & " Other Material Entries have been successfully inserted into the Entry Sheet Results."
End Sub
Is there any update of change to Excel. Wondering because we have never had this issue.
Worksheets("Errors").Buttons.Add(350, 10, 200, 25).Select Selection.OnAction = "ADDOTHERMATL"
You're assuming that Worksheets("Errors")
is the ActiveSheet
, for Selection
only ever refers to the selected object on the active sheet.
Instead, keep a reference to the added button - the Add
method returns that object:
Dim button As Object
Set button = Worksheets("Errors").Buttons.Add(350, 10, 200, 25)
Now set its OnAction
property:
button.OnAction = "ADDOTHERMATL"