Run-time error '1004': Application-defined or object-defined error

Status
Not open for further replies.

Pookiemeister

Well-known Member
Joined
Jan 6, 2012
Messages
530
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
On my spreadsheet I have named cells and some are merged. The cells that are named (merged and not merged) do not trigger the run-time error and the merged cells are on the same row. However, the problem occurs when the code gets to this line:
Code:
Range("C19:C32").Value = ""
but the line highlighted in yellow is
Code:
str01 = ActiveCell.Name.Name
which make sense, since the above code isn't a named range. All I am wanting to achieve is when the code reaches this line, loop through each cell starting in "C19" and ending on "C32" and perform this code which autosize merged cells to fit the text:
Code:
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

The full code is below.
VBA Code:
Private Sub UserForm_Initialize()
    answ = 0
    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("C19:C32").Select
    Range("C19:C32").Value = ""
    Range("D19:E32").Select
    Range("D19:E32").Value = ""
    Range("F19:K32").Select
    Range("F19:K32").Value = ""
    Range("L19:L32").Select
    Range("L19:L32").Value = ""
    Me.Caption = "Purchase Order Form " & "    Date: " & Format(Now, "mm/dd/yyyy") & "      Time: " & Format(Now, "hh:mm")
End Sub
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long
    Dim cellsAddress As String
      
    Debug.Print Selection.Cells.Address
    cellsAddress = Selection.Cells.Address
    Debug.Print cellsAddress
    
    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
    
        Dim str02 As String
    str02 = Cells(19, 3).Select
    str02 = ActiveCell.Address
    
    Select Case str02
        
        Case Is = Range("$C$19:$C$32").Address
            For i = 19 To 32
                Cells(i, 3).Select
                str02 = ActiveCell.Address
                
            Next i
        Case Is = Range("$D$19:$E$32").Address
            For i = 19 To 32
                Cells(i, 4).Select
                str02 = ActiveCell.Address

            Next i
        Case Is = Range("$F$19:$K$32").Address
            For i = 19 To 32
                Cells(i, 6).Select
                str02 = ActiveCell.Address

            Next i
        Case Is = Range("$L$19:$L$32").Address
             For i = 19 To 32
                Cells(i, 12).Select
                str02 = ActiveCell.Address

            Next i

        End Select
    End Select
End Sub

I really hope this makes sense. If you have any questions, please let me know. ThankYou.
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
Status
Not open for further replies.
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,164,659
Messages
5,838,643
Members
430,558
Latest member
Krampus

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