Results 1 to 7 of 7
  1. #1
    lccrews is offline Competent Performer
    Windows 10 Access 2016
    Join Date
    Aug 2017
    Location
    Los Angeles
    Posts
    194

    Error 1004: 'Range' of object '_Worksheet' failed


    I have a button on my form that exports an excel spreadsheet. I'm trying to add a bit of code to my VBA function to search a range of cells for data and if any cells have data, input a formula in the cell to the right. That formula would divide the cell with data by the cell at the bottom for a percentage. Can someone please tell me what I'm doing wrong?

    I'm getting the subject error on the following line:
    Code:
    Set SrchRng = wks.Range("C2:AF" & Lrow).Cells '<-- THIS LINE
    For Each Cel In SrchRng
    If Cel.Value <> "" Then
        Cel.Offset(0, 1).Formula = "=" & Cel.Address & "/" & wks.Cells(Lrow + 1, Cell.Column).Address
    End If
    Next
    Here is the entire code:
    Code:
    Private Sub Command19_Click()'Export to Excel
    Dim rs1 As DAO.Recordset
    Dim qdf As DAO.QueryDef
    Dim prm As DAO.Parameter
    Dim cnt As Integer
    Dim SrchRng As Range, Cel As Range
    Dim Lrow As Long, Lrow1 As Long
    
    Dim appExcel As Excel.Application
    Dim wbk As Excel.Workbook
    Dim wks As Excel.Worksheet
    Dim rng As Excel.Range
    
    Set db = CurrentDb
    Set appExcel = Excel.Application
    Set wbk = appExcel.Workbooks.Add
    Set wks = wbk.Worksheets(1)
    Set rng = wks.Range("A2")
    
    appExcel.Visible = False
    
    cnt = 1
    
    Set qdf = CurrentDb.QueryDefs("qry_Comparison_Bulk")
    For Each prm In qdf.Parameters
    prm.Value = Eval(prm.Name)
    Next
    
    Set rs1 = qdf.OpenRecordset()
    
    For Each fld In rs1.Fields
        wks.Cells(1, cnt).Value = fld.Name
        cnt = cnt + 1
    Next fld
    Call rng.CopyFromRecordset(rs1, 4000, 26)
    
    qdf.Close
    rs1.Close
    Set rs1 = Nothing
    Set qdf = Nothing
    
    For Colx = 4 To 26 Step 2
    Columns(Colx).Insert Shift:=xlToRight
    Next
    
    Set SrchRng = wks.Range("C2:AF" & Lrow).Cells
    For Each Cel In SrchRng
    If Cel.Value <> "" Then
        Cel.Offset(0, 1).Formula = "=" & Cel.Address & "/" & wks.Cells(Lrow + 1, Cell.Column).Address
    End If
    Next
    
    'Identifies the last row and row beneath it
    
    Lrow = wks.Cells(Rows.Count, "A").End(xlUp).Row
    Lrow1 = wks.Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    'Everything below is formatting
    
    With wks.Range("A" & Lrow1, "AF" & Lrow1)
    .Font.Bold = True
    .Font.ColorIndex = 2
    .Interior.ColorIndex = 16
    .HorizontalAlignment = xlRight
    End With
    
    With wks.Range("C2:AE" & Lrow)
    .NumberFormat = "0.000"
    End With
    
    wks.Cells(Lrow1, "C").Formula = "=SUM(C2:C" & Lrow & ")"
    wks.Cells(Lrow1, "E").Formula = "=SUM(E2:E" & Lrow & ")"
    wks.Cells(Lrow1, "G").Formula = "=SUM(G2:G" & Lrow & ")"
    wks.Cells(Lrow1, "I").Formula = "=SUM(I2:I" & Lrow & ")"
    wks.Cells(Lrow1, "K").Formula = "=SUM(K2:K" & Lrow & ")"
    wks.Cells(Lrow1, "M").Formula = "=SUM(M2:M" & Lrow & ")"
    wks.Cells(Lrow1, "O").Formula = "=SUM(O2:O" & Lrow & ")"
    wks.Cells(Lrow1, "Q").Formula = "=SUM(Q2:Q" & Lrow & ")"
    wks.Cells(Lrow1, "S").Formula = "=SUM(S2:S" & Lrow & ")"
    wks.Cells(Lrow1, "U").Formula = "=SUM(U2:U" & Lrow & ")"
    wks.Cells(Lrow1, "W").Formula = "=SUM(W2:W" & Lrow & ")"
    wks.Cells(Lrow1, "Y").Formula = "=SUM(Y2:Y" & Lrow & ")"
    wks.Cells(Lrow1, "AA").Formula = "=SUM(AA2:AA" & Lrow & ")"
    wks.Cells(Lrow1, "AC").Formula = "=SUM(AC2:AC" & Lrow & ")"
    wks.Cells(Lrow1, "AE").Formula = "=SUM(AE2:AE" & Lrow & ")"
    wks.Cells(Lrow1, "B").Formula = "TOTAL (MG)"
    
    With wks.Range("A1:AF1")
    .Font.Bold = True
    .Font.ColorIndex = 2
    .Interior.ColorIndex = 16
    .NumberFormat = "@"
    .HorizontalAlignment = xlCenter
    .EntireColumn.AutoFit
    End With
    
    appExcel.Visible = True
    
    End Sub

  2. #2
    Minty is offline VIP
    Windows 10 Access 2010 32bit
    Join Date
    Sep 2017
    Location
    UK - Wiltshire
    Posts
    3,001
    Range is a string but needs defining outside of your worksheet object as the quotes are part of the excel environment. So you need to do something like this

    Code:
      Dim MyRange          As String
      MyRange = "N2:N" & iNumberOfRows
    'Then later on use it something like 
         .Range(MyRange).Select
    DLookup Syntax and others http://access.mvps.org/access/general/gen0018.htm
    Please use the star below the post to say thanks if we have helped !
    ↓↓ It's down here ↓↓

  3. #3
    lccrews is offline Competent Performer
    Windows 10 Access 2016
    Join Date
    Aug 2017
    Location
    Los Angeles
    Posts
    194
    I tried the following edit but got error: invalid or unqualified reference. The bolded word is what tripped the error:
    Code:
    Dim MyRange As String
    MyRange = "C2:AF" & Lrow
    Set SrchRng = .Range(MyRange).Select
    For Each Cel In SrchRng
    If Cel.Value <> "" Then
        Cel.Offset(0, 1).Formula = "=" & Cel.Address & "/" & wks.Cells(Lrow + 1, Cell.Column).Address
    End If
    Next
    I also tried wks.Range but the original error came out.

  4. #4
    Minty is offline VIP
    Windows 10 Access 2010 32bit
    Join Date
    Sep 2017
    Location
    UK - Wiltshire
    Posts
    3,001
    You need to set the rng object not your SrchRng which you have defined as Range... ? (not sure that will work, shouldn't it be Excel.Range ? ? ?)

    So in your existing code
    Code:
    Set rng = wks.Range(MyRange)
    DLookup Syntax and others http://access.mvps.org/access/general/gen0018.htm
    Please use the star below the post to say thanks if we have helped !
    ↓↓ It's down here ↓↓

  5. #5
    lccrews is offline Competent Performer
    Windows 10 Access 2016
    Join Date
    Aug 2017
    Location
    Los Angeles
    Posts
    194
    I changed wks.Range(MyRange) -which got the original answer- to Excel.Range(MyRange). Using Excel.Range returned a similar error but with '_Global' instead of '_Worksheet'. That's progress?! lol

  6. #6
    Minty is offline VIP
    Windows 10 Access 2010 32bit
    Join Date
    Sep 2017
    Location
    UK - Wiltshire
    Posts
    3,001
    Here is some simple code I use to insert a barcode and format a table in Excel, perhaps you can see how it differs from yours and adapt it.

    Code:
    Private Sub FormatExportSheet(sfilename As String, sWrkSht As String)
    
    
        Dim sFile            As String
        Dim objXL            As Object
        Dim NumberOfRows     As Integer
        Dim MyRange          As String
    
    
        On Error GoTo FormatExportSheet_Error
    
    
        sFile = sfilename & ".xlsx"
    
    
        Set objXL = CreateObject("Excel.Application")
        'Set objXL = New Excel.Application
        objXL.Workbooks.Open (sFile)
        'objXL.Visible = True
        NumberOfRows = objXL.Worksheets(sWrkSht).UsedRange.Rows.Count
    
    
        MyRange = "N2:N" & NumberOfRows
    
    
        With objXL
            .Worksheets(sWrkSht).Activate
            .Worksheets(sWrkSht).Rows("1:1").Font.Bold = True
            .Columns("A:N").autofit
            .Range(MyRange).Select
            With .Selection.Font
                .Name = "ABC C39 Short Text"
                .Size = 16
            End With
            MyRange = "A1:N" & NumberOfRows
            .Worksheets(sWrkSht).ListObjects.Add(1, .Range(MyRange), , xlYes).Name = "Table1"
            .Range("A1").Select
            .ActiveWorkbook.Save
        End With
    
    
        objXL.Quit
        Set objXL = Nothing
    
    
        On Error GoTo 0
        Exit Sub
    
    
    FormatExportSheet_Error:
    
    
        Set objXL = Nothing
        MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure FormatExportSheet of ModCustomerImports"
    
    
    End Sub
    DLookup Syntax and others http://access.mvps.org/access/general/gen0018.htm
    Please use the star below the post to say thanks if we have helped !
    ↓↓ It's down here ↓↓

  7. #7
    lccrews is offline Competent Performer
    Windows 10 Access 2016
    Join Date
    Aug 2017
    Location
    Los Angeles
    Posts
    194
    I was able to figure this out guys/gals. Here is the code that worked for me:

    Code:
    Dim Cel As Range
    
    For Each Cel In wks.Range("C1:C5").Cells 
           If Cel.Value <> "" Then Cel.Offset(0, 1).Formula = "=" & Cel.Address & "/" & wks.Cells(Lrow, Cel.Column) 
        End If
    Next

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Replies: 9
    Last Post: 11-17-2020, 11:00 AM
  2. Method of range of object Global failed
    By ili_sophia in forum Import/Export Data
    Replies: 1
    Last Post: 10-09-2017, 05:21 AM
  3. Replies: 3
    Last Post: 09-18-2014, 12:24 PM
  4. Runtime error 1004 - Save method of workbook failed
    By captdkl02 in forum Programming
    Replies: 2
    Last Post: 01-03-2013, 05:53 AM
  5. Replies: 1
    Last Post: 07-13-2012, 07:58 PM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums