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

Pookiemeister

Active Member
Joined
Nov 26, 2015
Messages
315
Office Version
  1. 365
  2. 2010
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.

VBA Code:
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
Code:
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
 

Some videos you may like

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!

mrshl9898

Well-known Member
Joined
Feb 6, 2012
Messages
1,639
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

Well-known Member
Joined
Dec 3, 2018
Messages
12,594
Office Version
  1. 2007
Platform
  1. Windows
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.

VBA Code:
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

Active Member
Joined
Nov 26, 2015
Messages
315
Office Version
  1. 365
  2. 2010
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
VBA Code:
  If Not IsNumeric(Right(Selection.Name.Name, 1)) Then
Thank you both for your help
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,594
Office Version
  1. 2007
Platform
  1. Windows

ADVERTISEMENT

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

Active Member
Joined
Nov 26, 2015
Messages
315
Office Version
  1. 365
  2. 2010
The error occurs the first time the code enters into Worksheet_Change Subon this line.
VBA Code:
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

Well-known Member
Joined
Dec 3, 2018
Messages
12,594
Office Version
  1. 2007
Platform
  1. Windows

ADVERTISEMENT

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.
 

Watch MrExcel Video

Forum statistics

Threads
1,123,040
Messages
5,599,456
Members
414,312
Latest member
mikefire911

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
Top