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

Status
Not open for further replies.

Pookiemeister

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

Some videos you may like

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
Status
Not open for further replies.

Watch MrExcel Video

Forum statistics

Threads
1,127,590
Messages
5,625,674
Members
416,125
Latest member
NeedExcelHelp2021

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