none
Application-defined or object-defined error in excel vba macro

    Question

  • We recently migrated from office 2003 to office 2007. We have a excel spreadsheet with vba macros that suddenly has quit working. Following is the code that we are having problems with. The error is generated at the bolded line but I believe that actual problem may be with a line proceding that (underlined). Can anyone help?

    Sub ImportNewProgram()

    ' Add new sheet, delete if necessary

    UpdateStatus "Checking for program..."

     

    Dim w

     

    For Each w In Worksheets

    If w.Name = NewProgramForm.Programs.Text Then

    If MsgBox("The program " & NewProgramForm.Programs.Text & " already exists. Delete and recreate the sheet?", vbYesNo, "Program Already Exists") = vbNo Then

    w.Activate

    StatusDialog.Hide

    Unload StatusDialog

    Exit Sub

    End If

     

    w.Activate

     

    If Not ActiveWorkbook.Worksheets("NewProgramForm.Programs.Text").Delete Then

    w.Activate

    StatusDialog.Hide

    Unload StatusDialog

    Exit Sub

    End If

    End If

    Next

     

    UpdateStatus "Creating worksheet..."

     

    Worksheets("NewProgramSheetShell").Copy After:=Worksheets("Home")

    ActiveSheet.Name = NewProgramForm.Programs.Text

     

    Dim sheet

     

    Set sheet = Worksheets(NewProgramForm.Programs.Text)

     

    ActiveSheet.Visible = False

    Worksheets("Home").Activate

     

    With sheet.Cells(sheet.Range("CreationDate").Row, sheet.Range("CreationDate").Column)

    .Value = " - Created: " & Now

    .Font.Italic = True

    End With

     

    ' Set travel date

    UpdateStatus "Set birthday cutoff..."

    sheet.Cells(sheet.Range("ParamAdultBirthday").Row, sheet.Range("ParamAdultBirthday").Column).Value = (NewProgramForm.BdayMonth.ListIndex + 1) & "/" & NewProgramForm.BdayDay.Value & "/" & NewProgramForm.BdayYear

     

    ' Load customers

    UpdateStatus "Loading customers..."

     

    Dim sqlRS

    Set sqlRS = CreateObject("ADODB.Recordset")

    sqlRS.Open "SELECT DISTINCT cep.borrowedSales AS extendSales, cep.carryOverCurrYr AS carryOver, p.progId, cl.custNum, cl.custName, cl.tripDollarsYTD, cl.custAlpha, ce.manualDeduct, ce.creditDeduct FROM Registrations r" & _

    " INNER JOIN Programs p ON r.program = p.progId" & _

    " INNER JOIN CustomerLive cl ON r.customer = cl.custNum" & _

    " LEFT OUTER JOIN CustomerEdit ce ON r.customer = ce.custNum AND cl.tripYear = ce.TripYear" & _

    " LEFT OUTER JOIN CustomerEdit cep ON cl.custNum = cep.custNum AND cl.tripYear - 1 = cep.TripYear" & _

    " WHERE p.progTitle = '" & NewProgramForm.Programs.Text & "' AND cl.tripYear = " & NewProgramForm.TripYear.Text & " AND r.cancelDate IS NULL AND r.registerDate IS NOT NULL" & _

    " ORDER BY cl.custAlpha", DSN_SQL, 1, 1

     

    Dim i

    i = 0

    While Not sqlRS.EOF

    sheet.Cells(sheet.Range("CustomerNumRange").Row + i, sheet.Range("RefNumRange").Column).Value = sqlRS("progId") & "-" & sqlRS("custNum")

    sheet.Cells(sheet.Range("CustomerNumRange").Row + i, sheet.Range("CustomerNumRange").Column).Value = sqlRS("custNum")

    sheet.Cells(sheet.Range("CustomerNumRange").Row + i, sheet.Range("CustomerNumRange").Column + 1).Value = sqlRS("custName")

    sheet.Cells(sheet.Range("CustomerNumRange").Row + i, sheet.Range("CustomerNumRange").Column + 2).Value = sqlRS("custAlpha")

    sheet.Cells(sheet.Range("CustomerNumRange").Row + i, sheet.Range("QualSalesRange").Column).Value = sqlRS("tripDollarsYTD")

    sheet.Cells(sheet.Range("CustomerNumRange").Row + i, sheet.Range("CarryOverRange").Column).Value = sqlRS("carryOver")

    sheet.Cells(sheet.Range("CustomerNumRange").Row + i, sheet.Range("ManualDeductRange").Column).Value = sqlRS("manualDeduct")

    sheet.Cells(sheet.Range("CustomerNumRange").Row + i, sheet.Range("CreditDeductRange").Column).Value = sqlRS("creditDeduct")

    If Not IsNull(sqlRS("extendSales")) And IsNumeric(sqlRS("extendSales")) Then

    sheet.Cells(sheet.Range("CustomerNumRange").Row + i, sheet.Range("ExtendSalesRange").Column).formula = "=if(" & sheet.Cells(sheet.Range("CustomerNumRange").Row + i, sheet.Range("PrevTripRange").Column).Address & ">0,0," & sqlRS("extendSales") & ")"

    End If

    i = i + 1

    sqlRS.MoveNext

    Wend

     

    sqlRS.Close

     

    ' Load registrations

    Update

     

    Unload NewProgramForm

    UpdateStatus "Done."

    StatusDialog.Hide

    Unload StatusDialog

    sheet.Visible = True

    sheet.Activate

    End Sub

    Monday, November 16, 2009 8:03 PM

All replies

  • Hi there, I'm having a similar issue with migrating from Excel 03 to 07, I also narrowed it down to a With statement.

    With wbkWorkbook.Worksheets("Sheet 1")
        Do Until .Cells(mlRow, 5).Value = ""

    It seems to work in some Excel 2007 spreadsheets and not in others for some reason.

    Did you manage to find out the reason for this issue?
    Tuesday, January 05, 2010 12:08 PM
  • Hi again, just to follow up - I found that the reason it appeared to happen for me was because the external input workbook would not compile in Excel 2007.  I think it couldn't handle it in memory or something.

    If you can't fix all input workbooks to work with Excel 2007, one workaround would be to use code such as below

    Dim wsSht as Worksheet
    Set wsSht = wbkWorkbook.Worksheets("Sheet 1")
    With wsSht
        Do Until .Cells(mlRow, 5).Value = ""
    • Proposed as answer by ianmsmitchell Tuesday, January 05, 2010 1:39 PM
    Tuesday, January 05, 2010 1:38 PM