Solved

Application defined or object defined error

Posted on 2012-03-11
9
388 Views
Last Modified: 2012-03-11
Hi,
This works once and then it doesn't work again.
I can't understand the error.
Any help as usual is most appreciated.

I know the code looks a bit clumsy and maybe a loop would work better, but at least it worksonce.

Option Explicit
Public Sub Trimspaces()
On Error GoTo Err_Trimspaces
Dim Aresponse As Integer
Dim WS1 As Worksheet
Dim DSVdate As Range
Dim UpDateRange As Range
Set WS1 = Sheets("NewToyData")
Set DSVdate = WS1.Range("AM1").End(xlDown).Offset(1, 0)
Set UpDateRange = ActiveCell.Resize(1, 37)
Aresponse = MsgBox("Have you copied the DSV figures from the latest downloaded web-shared spreadsheet?" & vbCrLf & _
                   "And have you selected the next empty cell down in column A?", vbCritical + vbYesNo, "CRITICAL!")
If Aresponse = vbYes Then
    ActiveCell.Offset(, 3).Value = ActiveCell.Offset(0, 7).Value
    ActiveCell.Offset(, 7).ClearContents
    ActiveCell.Offset(, 6).Value = ActiveCell.Offset(0, 14).Value
    ActiveCell.Offset(, 14).ClearContents
    ActiveCell.Offset(, 9).Value = ActiveCell.Offset(0, 21).Value
    ActiveCell.Offset(, 21).ClearContents
    ActiveCell.Offset(, 12).Value = ActiveCell.Offset(0, 28).Value
    ActiveCell.Offset(, 28).ClearContents
    ActiveCell.Offset(, 15).Value = ActiveCell.Offset(0, 35).Value
    ActiveCell.Offset(, 35).ClearContents
    ActiveCell.Offset(, 18).Value = ActiveCell.Offset(0, 42).Value
    ActiveCell.Offset(, 42).ClearContents
    ActiveCell.Offset(, 21).Value = ActiveCell.Offset(0, 49).Value
    ActiveCell.Offset(, 49).ClearContents
    ActiveCell.Offset(, 24).Value = ActiveCell.Offset(0, 56).Value
    ActiveCell.Offset(, 56).ClearContents
    ActiveCell.Offset(, 27).Value = ActiveCell.Offset(0, 63).Value
    ActiveCell.Offset(, 63).ClearContents
    ActiveCell.Offset(, 30).Value = ActiveCell.Offset(0, 70).Value
    ActiveCell.Offset(, 70).ClearContents
    ActiveCell.Offset(, 33).Value = ActiveCell.Offset(0, 77).Value
    ActiveCell.Offset(, 77).ClearContents
    ActiveCell.Offset(, 36).Value = ActiveCell.Offset(0, 84).Value
    ActiveCell.Offset(, 84).ClearContents
    DSVdate = Range("AL1")
    UpDateRange.Copy
Dim wbk2 As Workbook
Dim wbk2path As String
'    wbk2path = "H:\All\Shipping Database\Call_Offs.xlsm"
    wbk2path = "C:\Users\StevieB\Desktop\Call_Offs.xlsm"
    Set wbk2 = Workbooks.Open(wbk2path)
    MsgBox "Select the row which corresponds to the" & vbCrLf & _
        "Saturday you are updating the DSV" & vbCrLf & _
        "figures from, and PasteSpecialValues" & vbCrLf & _
        "from the G column"
End If
    If Aresponse = vbNo Then
    Exit Sub
    End If
Exit_Trimspaces:
    Exit Sub
Err_Trimspaces:
    MsgBox Err.Description
    Resume Exit_Trimspaces
End Sub
0
Comment
Question by:Stephen Byrom
  • 4
  • 3
  • 2
9 Comments
 
LVL 33

Expert Comment

by:Norie
ID: 37707755
Which line of code does it error on?
0
 
LVL 1

Author Comment

by:Stephen Byrom
ID: 37707770
I don't know.
When I click the button that the code is attached to nothing seems to happen at all. Except the error. "application or object defined error"
0
 
LVL 33

Expert Comment

by:Norie
ID: 37707777
Try removing On Error GoTo Err_Trimspaces.

That won't solve the problem but it should give you a better idea where the error is happening.
0
 
LVL 41

Accepted Solution

by:
dlmille earned 500 total points
ID: 37707780
I believe its possible for you to get that error on this line:

Set DSVdate = WS1.Range("AM1").End(xlDown).Offset(1, 0)

If range AM1 has no data, then you're going to the bottom of the worksheet, THEN trying to get one more row lower.

If this is the case, then I suggest rewriting as follows (as it appears you're just trying to get the last row then go to the blank row below that:

set DVSdate = WS1.Range("AM" & ws1.Rows.Count).End(xlUp).Offset(1,0)

Here's your modified code:
Option Explicit


Public Sub Trimspaces()
On Error GoTo Err_Trimspaces
Dim Aresponse As Integer
Dim WS1 As Worksheet
Dim DSVdate As Range
Dim UpDateRange As Range
Set WS1 = Sheets("NewToyData")
Set DSVdate = WS1.Range("AM1").End(xlDown).Offset(1, 0)
Set DVSdate = WS1.Range("AM" & WS1.Rows.Count).End(xlUp).Offset(1, 0)
Set UpDateRange = ActiveCell.Resize(1, 37)
Aresponse = MsgBox("Have you copied the DSV figures from the latest downloaded web-shared spreadsheet?" & vbCrLf & _
                   "And have you selected the next empty cell down in column A?", vbCritical + vbYesNo, "CRITICAL!")
If Aresponse = vbYes Then
    ActiveCell.Offset(, 3).Value = ActiveCell.Offset(0, 7).Value
    ActiveCell.Offset(, 7).ClearContents
    ActiveCell.Offset(, 6).Value = ActiveCell.Offset(0, 14).Value
    ActiveCell.Offset(, 14).ClearContents
    ActiveCell.Offset(, 9).Value = ActiveCell.Offset(0, 21).Value
    ActiveCell.Offset(, 21).ClearContents
    ActiveCell.Offset(, 12).Value = ActiveCell.Offset(0, 28).Value
    ActiveCell.Offset(, 28).ClearContents
    ActiveCell.Offset(, 15).Value = ActiveCell.Offset(0, 35).Value
    ActiveCell.Offset(, 35).ClearContents
    ActiveCell.Offset(, 18).Value = ActiveCell.Offset(0, 42).Value
    ActiveCell.Offset(, 42).ClearContents
    ActiveCell.Offset(, 21).Value = ActiveCell.Offset(0, 49).Value
    ActiveCell.Offset(, 49).ClearContents
    ActiveCell.Offset(, 24).Value = ActiveCell.Offset(0, 56).Value
    ActiveCell.Offset(, 56).ClearContents
    ActiveCell.Offset(, 27).Value = ActiveCell.Offset(0, 63).Value
    ActiveCell.Offset(, 63).ClearContents
    ActiveCell.Offset(, 30).Value = ActiveCell.Offset(0, 70).Value
    ActiveCell.Offset(, 70).ClearContents
    ActiveCell.Offset(, 33).Value = ActiveCell.Offset(0, 77).Value
    ActiveCell.Offset(, 77).ClearContents
    ActiveCell.Offset(, 36).Value = ActiveCell.Offset(0, 84).Value
    ActiveCell.Offset(, 84).ClearContents
    DSVdate = Range("AL1")
    UpDateRange.Copy
Dim wbk2 As Workbook
Dim wbk2path As String
'    wbk2path = "H:\All\Shipping Database\Call_Offs.xlsm"
    wbk2path = "C:\Users\StevieB\Desktop\Call_Offs.xlsm"
    Set wbk2 = Workbooks.Open(wbk2path)
    MsgBox "Select the row which corresponds to the" & vbCrLf & _
        "Saturday you are updating the DSV" & vbCrLf & _
        "figures from, and PasteSpecialValues" & vbCrLf & _
        "from the G column"
End If
    If Aresponse = vbNo Then
    Exit Sub
    End If
Exit_Trimspaces:
    Exit Sub
Err_Trimspaces:
    MsgBox Err.Description
    Resume Exit_Trimspaces
End Sub

Open in new window


Cheers,

Dave
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 1

Author Comment

by:Stephen Byrom
ID: 37707786
this is the line where it breaks
Set DSVdate = WS1.Range("AM1").End(xlDown).Offset(1, 0)
0
 
LVL 41

Expert Comment

by:dlmille
ID: 37707796
Sorry - I had a typeo in my code:

Here it is, correcting that line, as I suggested:

set DVSdate = WS1.Range("AM" & ws1.Rows.Count).End(xlUp).Offset(1,0)

Option Explicit


Public Sub Trimspaces()
'On Error GoTo Err_Trimspaces
Dim Aresponse As Integer
Dim WS1 As Worksheet
Dim DSVdate As Range
Dim UpDateRange As Range
Dim wbk2 As Workbook
Dim wbk2path As String
        
    Set WS1 = Sheets("NewToyData")
    'Set DSVdate = WS1.Range("AM1").End(xlDown).Offset(1, 0)
    Set DSVdate = WS1.Range("AM" & WS1.Rows.Count).End(xlUp).Offset(1, 0)
    Set UpDateRange = ActiveCell.Resize(1, 37)
    
    Aresponse = MsgBox("Have you copied the DSV figures from the latest downloaded web-shared spreadsheet?" & vbCrLf & _
                       "And have you selected the next empty cell down in column A?", vbCritical + vbYesNo, "CRITICAL!")
                       
    If Aresponse = vbYes Then
        ActiveCell.Offset(, 3).Value = ActiveCell.Offset(0, 7).Value
        ActiveCell.Offset(, 7).ClearContents
        ActiveCell.Offset(, 6).Value = ActiveCell.Offset(0, 14).Value
        ActiveCell.Offset(, 14).ClearContents
        ActiveCell.Offset(, 9).Value = ActiveCell.Offset(0, 21).Value
        ActiveCell.Offset(, 21).ClearContents
        ActiveCell.Offset(, 12).Value = ActiveCell.Offset(0, 28).Value
        ActiveCell.Offset(, 28).ClearContents
        ActiveCell.Offset(, 15).Value = ActiveCell.Offset(0, 35).Value
        ActiveCell.Offset(, 35).ClearContents
        ActiveCell.Offset(, 18).Value = ActiveCell.Offset(0, 42).Value
        ActiveCell.Offset(, 42).ClearContents
        ActiveCell.Offset(, 21).Value = ActiveCell.Offset(0, 49).Value
        ActiveCell.Offset(, 49).ClearContents
        ActiveCell.Offset(, 24).Value = ActiveCell.Offset(0, 56).Value
        ActiveCell.Offset(, 56).ClearContents
        ActiveCell.Offset(, 27).Value = ActiveCell.Offset(0, 63).Value
        ActiveCell.Offset(, 63).ClearContents
        ActiveCell.Offset(, 30).Value = ActiveCell.Offset(0, 70).Value
        ActiveCell.Offset(, 70).ClearContents
        ActiveCell.Offset(, 33).Value = ActiveCell.Offset(0, 77).Value
        ActiveCell.Offset(, 77).ClearContents
        ActiveCell.Offset(, 36).Value = ActiveCell.Offset(0, 84).Value
        ActiveCell.Offset(, 84).ClearContents
        
        DSVdate = Range("AL1")
        UpDateRange.Copy
        
        '    wbk2path = "H:\All\Shipping Database\Call_Offs.xlsm"
        wbk2path = "C:\Users\StevieB\Desktop\Call_Offs.xlsm"
        Set wbk2 = Workbooks.Open(wbk2path)
        MsgBox "Select the row which corresponds to the" & vbCrLf & _
               "Saturday you are updating the DSV" & vbCrLf & _
               "figures from, and PasteSpecialValues" & vbCrLf & _
               "from the G column"
    End If
    If Aresponse = vbNo Then
        Exit Sub
    End If
Exit_Trimspaces:
    Exit Sub
Err_Trimspaces:
    MsgBox Err.Description
    Resume Exit_Trimspaces
End Sub

Open in new window


Dave
0
 
LVL 1

Author Closing Comment

by:Stephen Byrom
ID: 37707797
Thanks for that.
I now understand a little more about vba.
Thanks again
0
 
LVL 41

Expert Comment

by:dlmille
ID: 37707802
Unless you want otherwise, its always better to find the last row or last column, starting from the bottom (or right) and heading toward your data.

Wks.Range("A" & Wks.Rows.Count).End(XlUp) 'gets the last row with data in column A

Wks.Cells(1,Wks.Columns.Count).End(XlToLeft) 'gets the last column with data on row 1

Cheers,

Dave
0
 
LVL 1

Author Comment

by:Stephen Byrom
ID: 37707806
Thanks,
I've changed my code to reflect that EndUP advice and will use it from now on.
Thanks again for your help.
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
The view will learn how to download and install SIMTOOLS and FORMLIST into Excel, how to use SIMTOOLS to generate a Monte Carlo simulation of 30 sales calls, and how to calculate the conditional probability based on the results of the Monte Carlo …
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

947 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now