Search code examples
excelvbasubroutine

Excel VBA - run-time error'438'. Object doesnt support this property or method


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.


Solution

  •     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"