Runtime error '1004' Application-defined or object-defined error

[Pookiemeister]

Named Cells Spreadsheet Layout:
VendorName =(C7:E7)
VendorNumber=(C8:E8)
QuoteNumber=(C9:E:9)
PONumber=(L7:M7)

Quantity=(C19:C:32)

1. Quantity19=(C19)
2. Quantity20=(C20)

14. Quantity32=(C32)

ItemNum=(D19:E32)
1. ItemNum19=(D19:E19) Merged Cell
2. ItemNum20=(D20:E20) Merged Cell
.....
14. ItemNum32=(D32:E32) Merged Cell

Description=(F19:K32)
1. Description19=(F19:K19) Merged Cell
2. Description20=(F20:K20) Merged Cell
.....
14. Description32=(F32:K32) Merged Cell

UnitCost=(L19:L32)
1. UnitCost19=(L19)
2. UnitCost20=(L20)
......
14. UnitCost32=(L32)

When userform loads it select named cell "VendorName" and clears any values inside that cell, then jumps to the Private Sub Worksheet_Change(ByVal Target As Range). This sub looks at the cell and auto sizes all cells including the merged cells. Then returns back to the userform initialize and goes to then next line of code. When the sub gets to the Named range called Quantity, it select the entire range, then it will loop through each cell in that range and autosizes that cell, with or without text. I believe the problem occurs when the code reaches the ItemNum but code that is highlighted in yellow Debug.Print ActiveCell.Name.Name in the Private Sub Worksheet_Change(ByVal Target As Range). Please let me know if you have any question. Thank you.

Private Sub UserForm_Initialize()

    Worksheets("Purchase Order").Select
    Range("VendorName").Select
    Range("VendorName").Value = ""
    Range("VendorNumber").Select
    Range("VendorNumber").Value = ""
    Range("QuoteNumber").Select
    Range("QuoteNumber").Value = ""
    Range("PONumber").Select
    Range("PONumber").Value = ""
    Range("Quantity").Select
    Debug.Print ActiveCell.Address
    Range("Quantity").Value = ""
    Range("ItemNum").Select
    Debug.Print ActiveCell.Address
    Range("ItemNum").Value = ""
    Range("Description").Select
    Range("Description").Value = ""
    Range("UnitCost").Select
    Range("UnitCost").Value = ""
    Me.Caption = "Purchase Order Form " & "    Date: " & Format(Now, "mm/dd/yyyy") & "      Time: " & Format(Now, "hh:mm")
    answ = 0
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i, x As Long
    Dim cellName As String
    Dim cellName1 As String
    
'****************************************************
    Debug.Print Selection.Cells.Address
    ActiveCell.Select
    Debug.Print ActiveCell.Name.Name
    Debug.Print str01
    
    If Not IsNumeric(Right(ActiveCell.Name.Name, 1)) Then
        str01 = ActiveCell.Name.Name
        
        Select Case str01
        
            Case Is = "VendorName"
                If Not Intersect(Target, Range(str01)) Is Nothing Then
                    Application.ScreenUpdating = False
                    On Error Resume Next
                    Set AutoFitRng = Range(Range(str01).MergeArea.Address)
                    With AutoFitRng
                        .MergeCells = False
                        CWidth = .Cells(1).ColumnWidth
                        MergeWidth = 0
                        For Each cM In AutoFitRng
                            cM.WrapText = True
                            MergeWidth = cM.ColumnWidth + MergeWidth
                        Next
                        'small adjustment to temporary width
                        MergeWidth = MergeWidth + AutoFitRng.Cells.Count * 0.66
                        .Cells(1).ColumnWidth = MergeWidth
                        .EntireRow.AutoFit
                        NewRowHt = .RowHeight
                        .Cells(1).ColumnWidth = CWidth
                        .MergeCells = True
                        .RowHeight = NewRowHt
                    End With
                    Application.ScreenUpdating = True
                End If
            Case Is = "VendorNumber"
                If Not Intersect(Target, Range(str01)) Is Nothing Then
                    Application.ScreenUpdating = False
                    On Error Resume Next
                    Set AutoFitRng = Range(Range(str01).MergeArea.Address)
                    With AutoFitRng
                        .MergeCells = False
                        CWidth = .Cells(1).ColumnWidth
                        MergeWidth = 0
                        For Each cM In AutoFitRng
                            cM.WrapText = True
                            MergeWidth = cM.ColumnWidth + MergeWidth
                        Next
                    'small adjustment to temporary width
                        MergeWidth = MergeWidth + AutoFitRng.Cells.Count * 0.66
                        .Cells(1).ColumnWidth = MergeWidth
                        .EntireRow.AutoFit
                        NewRowHt = .RowHeight
                        .Cells(1).ColumnWidth = CWidth
                        .MergeCells = True
                        .RowHeight = NewRowHt
                    End With
                    Application.ScreenUpdating = True
                End If
            Case Is = "QuoteNumber"
                If Not Intersect(Target, Range(str01)) Is Nothing Then
                    Application.ScreenUpdating = False
                    On Error Resume Next
                    Set AutoFitRng = Range(Range(str01).MergeArea.Address)
                    With AutoFitRng
                        .MergeCells = False
                        CWidth = .Cells(1).ColumnWidth
                        MergeWidth = 0
                        For Each cM In AutoFitRng
                            cM.WrapText = True
                            MergeWidth = cM.ColumnWidth + MergeWidth
                        Next
                        'small adjustment to temporary width
                        MergeWidth = MergeWidth + AutoFitRng.Cells.Count * 0.66
                        .Cells(1).ColumnWidth = MergeWidth
                        .EntireRow.AutoFit
                        NewRowHt = .RowHeight
                        .Cells(1).ColumnWidth = CWidth
                        .MergeCells = True
                        .RowHeight = NewRowHt
                    End With
                    Application.ScreenUpdating = True
                End If
            Case Is = "PONumber"
                If Not Intersect(Target, Range(str01)) Is Nothing Then
                    Application.ScreenUpdating = False
                    On Error Resume Next
                    Set AutoFitRng = Range(Range(str01).MergeArea.Address)
                    With AutoFitRng
                        .MergeCells = False
                        CWidth = .Cells(1).ColumnWidth
                        MergeWidth = 0
                        For Each cM In AutoFitRng
                            cM.WrapText = True
                            MergeWidth = cM.ColumnWidth + MergeWidth
                        Next
                        'small adjustment to temporary width
                        MergeWidth = MergeWidth + AutoFitRng.Cells.Count * 0.66
                        .Cells(1).ColumnWidth = MergeWidth
                        .EntireRow.AutoFit
                        NewRowHt = .RowHeight
                        .Cells(1).ColumnWidth = CWidth
                        .MergeCells = True
                        .RowHeight = NewRowHt
                    End With
                    Application.ScreenUpdating = True
                End If
        End Select
    Else
        str01 = ActiveCell.Name.Name
        If IsNumeric(Right(str01, 1)) Then

            For i = 19 To 32
                    Cells(i, 3).Select
                If Not Intersect(Target, Range(str01)) Is Nothing Then
                    Application.ScreenUpdating = False
                    On Error Resume Next
                    Set AutoFitRng = Range(Range(str01).MergeArea.Address)
                    With AutoFitRng
                        .MergeCells = False
                        CWidth = .Cells(1).ColumnWidth
                        MergeWidth = 0
                        For Each cM In AutoFitRng
                            cM.WrapText = True
                            MergeWidth = cM.ColumnWidth + MergeWidth
                        Next
                        'small adjustment to temporary width
                        MergeWidth = MergeWidth + AutoFitRng.Cells.Count * 0.66
                        .Cells(1).ColumnWidth = MergeWidth
                        .EntireRow.AutoFit
                        NewRowHt = .RowHeight
                        .Cells(1).ColumnWidth = CWidth
                        .MergeCells = True
                        .RowHeight = NewRowHt
                    End With
                    Application.ScreenUpdating = True
                End If
            Next i
        End If
End If
'****************************************************
End Sub

 

[mrshl9898]

What is activecell.name supposed to return? name isn't a property of activecell.

Maybe activecell.value might be what is needed if you're looking for what is written in there

 

[DanteAmor]

I don't understand why every time you start the form you have to rebuild the merged cells.
It would be easier if you have a sheet as a template with combined cells, texts, colors, etc. And then when you start the form, just copy the template to the sheet "Purchase Order"

Another problem you have, if you modify any cell on the sheet, the event is triggered and you will have the error, because it may be that the cell does not have a named range.

Just as a general culture, your code can be simplified as follows. I did a test to load the form and it doesn't send errors.
But you should take the advice of the template.

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim i, x As Long
  Dim cellName As String
  Dim cellName1 As String
  Dim str01, AutoFitRng, CWidth, MergeWidth, cM, NewRowHt
 
  '**************************************************** 
  If Not IsNumeric(Right(Selection.Name.Name, 1)) Then
    str01 = Selection.Name.Name
    Select Case str01
    Case "VendorName", "VendorNumber", "QuoteNumber", "PONumber"
      If Not Intersect(Target, Range(str01)) Is Nothing Then
      'On Error Resume Next
      Set AutoFitRng = Range(str01)
      With AutoFitRng
        .MergeCells = False
        CWidth = .Cells(1).ColumnWidth
        MergeWidth = 0
        For Each cM In AutoFitRng
          cM.WrapText = True
          MergeWidth = cM.ColumnWidth + MergeWidth
        Next
        'small adjustment to temporary width
        MergeWidth = MergeWidth + AutoFitRng.Cells.Count * 0.66
        .Cells(1).ColumnWidth = MergeWidth
        .EntireRow.AutoFit
        NewRowHt = .RowHeight
        .Cells(1).ColumnWidth = CWidth
        .MergeCells = True
        .RowHeight = NewRowHt
      End With
      End If
    End Select
  Else
    str01 = ActiveCell.Name.Name
    If IsNumeric(Right(str01, 1)) Then
      For i = 19 To 32
        Cells(i, 3).Select
        If Not Intersect(Target, Range(str01)) Is Nothing Then
          Set AutoFitRng = Range(Range(str01).MergeArea.Address)
          With AutoFitRng
            .MergeCells = False
            CWidth = .Cells(1).ColumnWidth
            MergeWidth = 0
            For Each cM In AutoFitRng
              cM.WrapText = True
              MergeWidth = cM.ColumnWidth + MergeWidth
            Next
            'small adjustment to temporary width
            MergeWidth = MergeWidth + AutoFitRng.Cells.Count * 0.66
            .Cells(1).ColumnWidth = MergeWidth
            .EntireRow.AutoFit
            NewRowHt = .RowHeight
            .Cells(1).ColumnWidth = CWidth
            .MergeCells = True
            .RowHeight = NewRowHt
          End With
        End If
      Next i
    End If
  End If
  '****************************************************
End Sub

 

[Pookiemeister]

How do you quote somebody in this forum?
@mrshl9898 Maybe activecell.value might be what is needed if you're looking for what is written in there

Yes, that's correct.

@DanteAmor
After I commented out my code, I copied and pasted your code. When I step through it, I get a runtime error '1004: Application-defined or obect-defined error on this line

  If Not IsNumeric(Right(Selection.Name.Name, 1)) Then

Thank you both for your help

 

[DanteAmor]

At what point does the error occur?
When does the userform start? or when you modify any cell?
As I mentioned, if you modify any cell, the event is triggered and you will have errors, because there are cells without named range.
That error is because the cell you are modifying does not have a named range.
I am inclined to create a template sheet and not update the merged cells every time.

 

[Pookiemeister]

The error occurs the first time the code enters into Worksheet_Change Subon this line.

If Not IsNumeric(Right(Selection.Name.Name, 1)) Then

<quote> I am inclined to create a template sheet and not update the merged cells every time. </quote>
So how can I achieve this same task only when the merged cell contains a value? Thank You

 

[DanteAmor]

The error occurs the first time the code enters into Worksheet_Change Subon this line.

I mean when you open the userform or after opening the userform and modify a cell.

So how can I achieve this same task only when the merged cell contains a value?

I don't understand why every time you start the form you have to rebuild the merged cells.

 

[Pookiemeister]

The error occurs before the form loads.

 

[DanteAmor]

Check my test file:

purchase order.xlsm

drive.google.com