Error '1004': Application defined or Object defined error?

websmythe

New Member
Joined
Apr 1, 2009
Messages
16
Could anybody shed any light on why I'm getting a
Runtime Error '1004': Application defined or Object defined error?
I've been searching the net and found a note about using full naming,
eg: ActiveWorkbook.Sheets("Estimate").Range(BlankRngStr) ,
but it didn't fix it. The red line is the point that it starts to error out.
If I comment out the line it just moves to the next. Thanx

Code:
Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean)
    
    Dim Msg, Style, Title, Response
    Dim ThisSum, ThisRngStr, BlankRngStr
    Dim SubTotalRng, TxtRng As Range
    
    ThisSum = WorksheetFunction.Sum(Target)
    
    Msg = "Current SubTotal = " & Format(ThisSum, "$#,###,##0.00") _
    & vbCrLf & vbCrLf & "Insert SubTotal into Sheet?"
    
        Style = vbYesNo + vbQuestion + vbDefaultButton2   ' Define buttons.
        Title = "SubTotal"    ' Define title.
        
        Response = MsgBox(Msg, Style, Title)
        Cancel = True
        
        If Response = vbYes Then    ' User chose Yes.
       
            ' get Address rng from selection
            ThisRngStr = ActiveWindow.RangeSelection.Address
            BlankRngStr = Mid(ThisRngStr, InStr(ThisRngStr, ":") + 1)
            
            Set SubTotalRng = ActiveWorkbook.Sheets("Estimate").Range(BlankRngStr)
            
            If SubTotalRng.Value <> "" Then
                Msg = "No Blank cell found at end of selection" & vbCrLf _
                & "Please include a blank cell at the end" & vbCrLf & "of your selection"
                Style = vbOKOnly + vbExclamation ' Define buttons.
                Title = "No Blank Cell Found"    ' Define title.
        
                Response = MsgBox(Msg, Style, Title)
        
            Else
                
                ' get the cell beside the Subtotal
                Set TxtRng = ActiveWorkbook.Sheets("Estimate").Cells(SubTotalRng.Row, SubTotalRng.Column - 1)
                
                ' place the word SubTotal in the cell to the left of the last cell
                [COLOR="Red"]TxtRng.Formula = ""[/COLOR]
                TxtRng.Font.Bold = True
                TxtRng.Value = "SubTotal"
                
                ' place SubTotal formula in last cell
                SubTotalRng.Formula = ""
                SubTotalRng.Font.Bold = True
                SubTotalRng.Value = "=SUM(" & ThisRngStr & ")"

            End If
        
        End If
    
End Sub
 

Some videos you may like

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

Richard Schollar

MrExcel MVP
Joined
Apr 19, 2005
Messages
23,707
That line and the following are completely superfluous (you don't need them as you assign a value to the cell later on). Re-write to:

Code:
Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean)
    
    Dim Msg, Style, Title, Response
    Dim ThisSum, ThisRngStr, BlankRngStr
    Dim SubTotalRng, TxtRng As Range
    
    ThisSum = WorksheetFunction.Sum(Target)
    
    Msg = "Current SubTotal = " & Format(ThisSum, "$#,###,##0.00") _
    & vbCrLf & vbCrLf & "Insert SubTotal into Sheet?"
    
        Style = vbYesNo + vbQuestion + vbDefaultButton2   ' Define buttons.
        Title = "SubTotal"    ' Define title.
        
        Response = MsgBox(Msg, Style, Title)
        Cancel = True
        
        If Response = vbYes Then    ' User chose Yes.
       
            ' get Address rng from selection
            ThisRngStr = ActiveWindow.RangeSelection.Address
            BlankRngStr = Mid(ThisRngStr, InStr(ThisRngStr, ":") + 1)
            
            Set SubTotalRng = ActiveWorkbook.Sheets("Estimate").Range(BlankRngStr)
            
            If SubTotalRng.Value <> "" Then
                Msg = "No Blank cell found at end of selection" & vbCrLf _
                & "Please include a blank cell at the end" & vbCrLf & "of your selection"
                Style = vbOKOnly + vbExclamation ' Define buttons.
                Title = "No Blank Cell Found"    ' Define title.
        
                Response = MsgBox(Msg, Style, Title)
        
            Else
                
                ' get the cell beside the Subtotal
                Set TxtRng = ActiveWorkbook.Sheets("Estimate").Cells(SubTotalRng.Row, SubTotalRng.Column - 1)
                
                ' place the word SubTotal in the cell to the left of the last cell
                TxtRng.Font.Bold = True
                TxtRng.Value = "SubTotal"
                
                ' place SubTotal formula in last cell

                SubTotalRng.Font.Bold = True
                SubTotalRng.Formula = "=SUM(" & ThisRngStr & ")"

            End If
        
        End If
    
End Sub
 

websmythe

New Member
Joined
Apr 1, 2009
Messages
16
That line and the following are completely superfluous (you don't need them as you assign a value to the cell later on).

Didn't think of that. Thanx.
But the error then shifts to the following line.

I guess I shoud be writing the SUM statement to the formulla anyways, instead of the value.
Rich (BB code):
' get the cell beside the Subtotal
Set TxtRng = ActiveWorkbook.Sheets("Estimate").Cells(SubTotalRng.Row, SubTotalRng.Column - 1)
 
' place the word SubTotal in the cell to the left of the last cell
TxtRng.Font.Bold = True
TxtRng.Value = "SubTotal"
 
' place SubTotal formula in last cell
SubTotalRng.Font.Bold = True
SubTotalRng.Formula = "=SUM(" & ThisRngStr & ")"
 

Colin Legg

MrExcel MVP
Joined
Feb 28, 2008
Messages
3,497
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Is that worksheet protected by any chance (with format cells ticked if TxtRng.Font.Bold doesn't throw an error)?
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,123,402
Messages
5,601,475
Members
414,452
Latest member
Dannysamworth

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