Solved

Why do I get this VBA error message when creating an Excel spreadsheet in Access?

Posted on 2012-04-05
6
399 Views
Last Modified: 2012-04-05
I am developing an Access 2007 "project" (.adp) as a front-end to data stored in a SQL Server 2005 Express database.

One task I allow the operator to do in the Access application is to create an Excel spreadsheet for carrying out a stock count in a shop.

Using VBA code behind the scenes, I declare the following variables :

    Dim rsTarget As New ADODB.Recordset
   
    Dim oApp As New Excel.Application
    Dim oBook As Excel.Workbook
    Dim oSheet As Excel.Worksheet

I populate rsTarget with a SQL query and then

    Set oBook = oApp.Workbooks.Add
    Set oSheet = oBook.Worksheets(1)

In a "With oSheet" block of coding I copy the data from the recordset into the spreadsheet using

            .Range("A7").CopyFromRecordset rsTarget

I can also do various cell formatting tasks and evrything seems to work OK.

However, I am getting an error message when I try to merge a few cells so that the shop name will be visible across a few columns.
I have carried out this task in a spreadsheet while recording a macro so that I can see the instructions that are being carried out. These appear to be as below :

                    Range("C1:G1").Select
                    With Selection
                        .HorizontalAlignment = xlCenter
                        .VerticalAlignment = xlBottom
                        .WrapText = False
                        .Orientation = 0
                        .AddIndent = False
                        .IndentLevel = 0
                        .ShrinkToFit = False
                        .ReadingOrder = xlContext
                        .MergeCells = False
                    End With
                    Selection.Merge
                    With Selection
                        .HorizontalAlignment = xlLeft
                        .VerticalAlignment = xlBottom
                        .WrapText = False
                        .Orientation = 0
                        .AddIndent = False
                        .IndentLevel = 0
                        .ShrinkToFit = False
                        .ReadingOrder = xlContext
                        .MergeCells = True
                    End With

When I plug these into my VBA code, it compiles OK but I get the run-time error message :

Method 'Range' of object '_Global' failed

Can anyone explain why this happens and what I need to do to avoid it?

Many thanks.
0
Comment
Question by:colinasad
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 2
6 Comments
 
LVL 120

Expert Comment

by:Rey Obrero (Capricorn1)
ID: 37810505
you need to reference the range() from the active sheet, like what you did with the  copyfromrecordset

with oSheet
  .Range("C1:G1").Select
0
 

Author Comment

by:colinasad
ID: 37810611
Thanks for the prompt response, capricorn1.

I am doing my "Range("C1:G1").Select" line inside a "With oSheet" block, but had omitted the leading "." character.
".Range("C1:G1").Select"
seems to avoid the error message I was getting.

However I am now getting the run-time error :

"Object variable or With block variable not set"

This is happening just inside the "With Selection ..." block of code immediately following the ".Range("C1:G1").Select" line.
Is there a prefix I should be adding to the "Selection" expression?
".Selection" causes a VBA compilation error.
0
 
LVL 120

Expert Comment

by:Rey Obrero (Capricorn1)
ID: 37810684
post the WHOLE codes
0
Enterprise Mobility and BYOD For Dummies

Like “For Dummies” books, you can read this in whatever order you choose and learn about mobility and BYOD; and how to put a competitive mobile infrastructure in place. Developed for SMBs and large enterprises alike, you will find helpful use cases, planning, and implementation.

 

Author Comment

by:colinasad
ID: 37810728
Thanks, capricorn1.

Here is my "spreadheet producing" VBA procedure in its entirity.
Hopefully you can filter the relevant "Excel" handling commands from the data handling instructions.
The procedure is peppered with an "intPosn" variable that I use in the "HandleError" message allowing me to pin-point precisely where the code breaks down.
The most recent error is happening at intPosn = 1921.


Public Sub CreateShopMerchExcel(strShopCode As String)
    ' Try and populate a spreadsheet with data for Merchandising a shop
    ' This approach results in Excel being launched with the filled spreadsheet offered to the user
    ' The user can then save the spreadsheet as they wish
   
    ' Complicated bit is listing the quantity delivered in an unknown number of deliveries
    ' since the last Stock Count.
    ' These "events" have already been saved in TBL_TempShopMerchEvents
    ' We allow for 3 of these deliveries since the previous stock count

On Error GoTo HandleError
    Dim intPosn As Integer
   
intPosn = 100
   
    Dim strSQLCommand As String
   
    Dim blnProceed As Boolean
   
    Dim lngLines As Long
    Dim intColumns As Integer
   
    Dim intCounter As Integer
   
    Dim strShopName As String
    Dim datPrevCountDate As Date
   
    Dim intMaxRecentDelvs As Integer
    Dim intNumRecentDelvs As Integer
    Dim strDelvRef1 As String
    Dim strDelvRef2 As String
    Dim strDelvRef3 As String
    Dim datDelvDate1 As Date
    Dim datDelvDate2 As Date
    Dim datDelvDate3 As Date
   
   
    Dim rsTarget As New ADODB.Recordset
   
    Dim oApp As New Excel.Application
    Dim oBook As Excel.Workbook
    Dim oSheet As Excel.Worksheet

intPosn = 110
   
    intMaxRecentDelvs = 3
    intNumRecentDelvs = 0
   
    strDelvRef1 = ""
    strDelvRef2 = ""
    strDelvRef3 = ""
    datDelvDate1 = "01/01/1900"
    datDelvDate2 = "01/01/1900"
    datDelvDate3 = "01/01/1900"
   
    blnProceed = True
   
    If genAllBlanks(Nz(strShopCode, "")) Then
        MsgBox "No instruction received to populate spreadsheet", , "Fill Spreadsheet"
    Else
        strShopName = ReadRecordField("String", strShopCode, "", "", _
                                            "TBL_Shops", _
                                            "Shop_Code", "", "", _
                                            "Shop_Name")
        datPrevCountDate = ReadRecordField("Date", strShopCode, "", "", _
                                            "TBL_Shops", _
                                            "Shop_Code", "", "", _
                                            "Shop_LastCountDate")
                               
intPosn = 112
        ' strSQLCommand for reading recent delivery events
        ' Previously filled with events since the Shops previous Stock Count Date
       
        strSQLCommand = "SELECT * " & _
                    "FROM TBL_TempShopMerchEvents " & _
                    "WHERE ShpMerchEvent_ShopCode = '" & strShopCode & "' " & _
                    "ORDER BY ShpMerchEvent_Date"

        ' Fill the Recordset based on the SQL Command
        Set rsTarget = ReadRecordset(strSQLCommand)
intPosn = 114
           
        If Not (rsTarget.BOF And rsTarget.EOF) Then
intPosn = 116
            intNumRecentDelvs = rsTarget.RecordCount
            intColumns = rsTarget.Fields.Count
           
            If intNumRecentDelvs > intMaxRecentDelvs Then
                MsgBox "Number of recent deliveries : " & intNumRecentDelvs & vbCrLf & _
                        "Exceeds maximum allowed : " & intMaxRecentDelvs & vbCrLf & _
                        "Cannot Proceed", , "Shop Stock Count Sheet Export"
               
                blnProceed = False
            End If
           
            If intNumRecentDelvs > 0 Then
                rsTarget.MoveFirst
               
                For intCounter = 1 To intNumRecentDelvs
                    Select Case intCounter
                        Case 1
                            strDelvRef1 = Nz(rsTarget.Fields("ShpMerchEvent_Reference"), "")
                            datDelvDate1 = Nz(rsTarget.Fields("ShpMerchEvent_Date"), "01/01/1900")
                        Case 2
                            strDelvRef2 = Nz(rsTarget.Fields("ShpMerchEvent_Reference"), "")
                            datDelvDate2 = Nz(rsTarget.Fields("ShpMerchEvent_Date"), "01/01/1900")
                        Case 3
                            strDelvRef3 = Nz(rsTarget.Fields("ShpMerchEvent_Reference"), "")
                            datDelvDate3 = Nz(rsTarget.Fields("ShpMerchEvent_Date"), "01/01/1900")
                    End Select
                   
                    rsTarget.MoveNext
                Next intCounter
            End If
        End If
           
        ' Close and Clear the recordset from memory
        rsTarget.Close
        Set rsTarget = Nothing
       
        MsgBox "Have checked for recent deliveries." & vbCrLf & _
                "Max deliveries allowed : " & intMaxRecentDelvs & vbCrLf & _
                "Number of deliveries found : " & intNumRecentDelvs & vbCrLf & _
                "Delv Date 1 : " & datDelvDate1 & "   Delv Ref 1 : " & strDelvRef1 & vbCrLf & _
                "Delv Date 2 : " & datDelvDate2 & "   Delv Ref 2 : " & strDelvRef2 & vbCrLf & _
                "Delv Date 3 : " & datDelvDate3 & "   Delv Ref 3 : " & strDelvRef3, , _
                "Shop Stock Count Sheet Export"
       
        If blnProceed Then
            ' Re-use the recordset for spreadsheet data
           
            lngLines = 0
            intColumns = 0
           
            ' strSQLCommand for reading required data into a recordset
            strSQLCommand = "SELECT ShpMerchStock_APTightCode, ShpMerchStock_Category, " & _
                        "ShpMerchStock_StockCode, '' AS 'THISCOUNT', " & _
                        "CONVERT (varchar(20), ShpMerchStock_LastCountDate, 103) AS 'LASTCOUNTDATE', " & _
                        "ShpMerchStock_LastCountQnt, " & _
                        "ShpMerchStock_DeliveredSince, " & _
                        "ShpMerchStock_LastCountQnt + ShpMerchStock_DeliveredSince AS 'AVAIL', " & _
                        "'', " & _
                        "ISNULL (DLV1.ShpStkHst_Qnty, '') AS 'DLV1QNT', " & _
                        "ISNULL (DLV2.ShpStkHst_Qnty, '') AS 'DLV2QNT', " & _
                        "ISNULL (DLV3.ShpStkHst_Qnty, '') AS 'DLV3QNT' " & _
                        "FROM TBL_TempShopMerchStockCodes " & _
                        "LEFT OUTER JOIN TBL_ShopStockHistory AS DLV1 " & _
                        "ON DLV1.ShpStkHst_ShopCode = '" & strShopCode & "' AND DLV1.ShpStkHst_Ref = '" & strDelvRef1 & "' " & _
                        "AND DLV1.ShpStkHst_StockCode = ShpMerchStock_StockCode " & _
                        "LEFT OUTER JOIN TBL_ShopStockHistory AS DLV2 " & _
                        "ON DLV2.ShpStkHst_ShopCode = '" & strShopCode & "' AND DLV2.ShpStkHst_Ref = '" & strDelvRef2 & "' " & _
                        "AND DLV2.ShpStkHst_StockCode = ShpMerchStock_StockCode " & _
                        "LEFT OUTER JOIN TBL_ShopStockHistory AS DLV3 " & _
                        "ON DLV3.ShpStkHst_ShopCode = '" & strShopCode & "' AND DLV3.ShpStkHst_Ref = '" & strDelvRef3 & "' " & _
                        "AND DLV3.ShpStkHst_StockCode = ShpMerchStock_StockCode " & _
                        "WHERE ShpMerchStock_ShopCode = '" & strShopCode & "' " & _
                        "ORDER BY ShpMerchStock_StockCode"
    intPosn = 125
            ' MsgBox "strSQLCommand : Length : " & Len(strSQLCommand) & vbCrLf & strSQLCommand, , "Export Spreadsheet"
           
            ' Fill the Recordset based on the SQL Command
            Set rsTarget = ReadRecordset(strSQLCommand)
    intPosn = 130
               
            ' Proceed only if the Recordset contains some rows
            If Not (rsTarget.BOF And rsTarget.EOF) Then
    intPosn = 140
                lngLines = rsTarget.RecordCount
                intColumns = rsTarget.Fields.Count
               
                ' Tell the user how many columns and rows of data the spreadsheet will contain
                MsgBox "Processing RecordSet with :" & vbCrLf & _
                            intColumns & "  Columns" & vbCrLf & _
                            lngLines & "  Lines", , "Fill Spreadsheet"
                           
                ' Prepare an Excel Workbook and Sheet
                Set oBook = oApp.Workbooks.Add
                Set oSheet = oBook.Worksheets(1)
    intPosn = 150
               
                With oSheet
                    ' First 3 rows are Shop Code, Printed Date, Count Date
                    ' Row 1 is the Shop Code - All text
                    .Cells(1, 1).VALUE = "Shop Code"
                    .Cells(1, 2).VALUE = strShopCode
                    .Cells(1, 3).VALUE = strShopName
                   
                    ' Row 2 is the printout date and Previous Shop Count Date
                    .Cells(2, 1).VALUE = "Issue Date"
                    .Cells(2, 2).VALUE = Date
                    .Cells(2, 5).VALUE = "Last Count"
                    .Cells(2, 6).VALUE = datPrevCountDate
                   
                    ' Row 3 is the count date - will be filled later by the Merchandiser
                    .Cells(3, 1).VALUE = "Count Date"
                   
                    ' Row 4 is left blank
                   
                    ' Row 5 is the first row of column headers
                    .Cells(5, 1).VALUE = "AP"
                    .Cells(5, 2).VALUE = ""
                    .Cells(5, 3).VALUE = "Joe Cool"
                    .Cells(5, 4).VALUE = "NEW"
                    .Cells(5, 5).VALUE = "Previous"
                    .Cells(5, 6).VALUE = "Previous"
                    .Cells(5, 7).VALUE = "Delivered"
                    .Cells(5, 8).VALUE = "Available"
                   
                    .Cells(5, 10).VALUE = datDelvDate1
                    .Cells(5, 11).VALUE = datDelvDate2
                    .Cells(5, 12).VALUE = datDelvDate3
                   
                    ' Row 6 is the second row of column headers
                    .Cells(6, 1).VALUE = "Code"
                    .Cells(6, 2).VALUE = "Category"
                    .Cells(6, 3).VALUE = "Code"
                    .Cells(6, 4).VALUE = "COUNT"
                    .Cells(6, 5).VALUE = "Count Date"
                    .Cells(6, 6).VALUE = "Count Qnty"
                    .Cells(6, 7).VALUE = "Since"
                    .Cells(6, 8).VALUE = "Since"
               
                    .Cells(6, 10).VALUE = strDelvRef1
                    .Cells(6, 11).VALUE = strDelvRef2
                    .Cells(6, 12).VALUE = strDelvRef3
                   
                   
                End With
    intPosn = 160
               
                ' Make all the Header Rows Bold & Text Format
                With oSheet.Rows("1:6")
    intPosn = 161
                    .NumberFormat = "@"
    intPosn = 162
                    .Font.Bold = True
    intPosn = 170
                End With
               
                With oSheet
                    ' Apart from date cells
                    .Cells(2, 2).NumberFormat = "dd/mm/yyy;@"  ' Report Date
                    .Cells(2, 6).NumberFormat = "dd/mm/yyy;@"  ' Shop Last Count Date
                    .Cells(3, 2).NumberFormat = "dd/mm/yyy;@"  ' New Count Date
                   
                    ' And the last Delivery Dates
                    .Cells(5, 10).NumberFormat = "dd/mm/yyy;@" ' Recent Delivery 1 Date
                    .Cells(5, 11).NumberFormat = "dd/mm/yyy;@" ' Recent Delivery 2 Date
                    .Cells(5, 12).NumberFormat = "dd/mm/yyy;@" ' Recent Delivery 3 Date
                   
                    'Add all the data from the Recordset, starting at cell A7
                    .Range("A7").CopyFromRecordset rsTarget
intPosn = 180
           
                    ' Make the Text columns left-justified
                    .Columns("A:C").HorizontalAlignment = xlLeft
intPosn = 185
                    ' Make the Qnty columns right-justified
                    .Columns("D:L").HorizontalAlignment = xlRight
                       
intPosn = 190
                 
                    ' Merge cells containing shop name
                    .Range("C1:G1").Select
intPosn = 192
                    With Selection
 intPosn = 1921
                        .HorizontalAlignment = xlCenter
 intPosn = 1922
                        .VerticalAlignment = xlBottom
 intPosn = 1923
                        .WrapText = False
 intPosn = 1924
                        .Orientation = 0
 intPosn = 1925
                        .AddIndent = False
                        .IndentLevel = 0
                        .ShrinkToFit = False
                        .ReadingOrder = xlContext
                        .MergeCells = False
                    End With
    intPosn = 194
                    Selection.Merge
    intPosn = 196
                    With Selection
                      .HorizontalAlignment = xlLeft
                      .VerticalAlignment = xlBottom
                      .WrapText = False
                      .Orientation = 0
                      .AddIndent = False
                      .IndentLevel = 0
                      .ShrinkToFit = False
                      .ReadingOrder = xlContext
                      .MergeCells = True
                  End With
intPosn = 198
       
                   
                    'Autofit the columns
                    .Columns("A:L").EntireColumn.AutoFit
       
    intPosn = 200
                    ' Position cursor in cell A1 - ready for the operator
                    .Range("A1").Select
    intPosn = 210
                End With
               
                ' Pass control of the spreadsheet over to the operator
                oApp.Visible = True
                oApp.UserControl = True
    intPosn = 220
       
            Else
                MsgBox "No data has been found to transfer to a spreadsheet", , "Spreadsheet Create"
            End If
           
            ' Close and Clear the recordset from memory
            rsTarget.Close
            Set rsTarget = Nothing
        End If
    End If
   
    Exit Sub
   
HandleError:
    genErrorHandler Err.Number, Err.DESCRIPTION, "DB_LOGIC", "CreateShopMerchExcel Pos " & intPosn
   
    Exit Sub
End Sub ' CreateShopMerchExcel
0
 
LVL 33

Accepted Solution

by:
Norie earned 500 total points
ID: 37811480
Instead of using Selection in the With use the actual range
                   intPosn = 192
                    With  .Range("C1:G1")
 intPosn = 1921
                        .HorizontalAlignment = xlCenter
 intPosn = 1922
                        .VerticalAlignment = xlBottom
 intPosn = 1923
                        .WrapText = False
 intPosn = 1924
                        .Orientation = 0
 intPosn = 1925
                        .AddIndent = False
                        .IndentLevel = 0
                        .ShrinkToFit = False
                        .ReadingOrder = xlContext
                        .MergeCells = False
                    End With
    intPosn = 194
                    . .Range("C1:G1").Merge
    intPosn = 196
                    With  .Range("C1:G1").
                      .HorizontalAlignment = xlLeft
                      .VerticalAlignment = xlBottom
                      .WrapText = False
                      .Orientation = 0
                      .AddIndent = False
                      .IndentLevel = 0
                      .ShrinkToFit = False
                      .ReadingOrder = xlContext
                      .MergeCells = True
                  End With

Open in new window

By the way, you don't need to merge to display the data across columns, you can use the alignment Center across selection.

    With  .Range("C1:G1")
            .HorizontalAlignment = xlCenterAcrossSelection    
    End With

Open in new window

0
 

Author Closing Comment

by:colinasad
ID: 37811595
Many thanks, imnorie.
Your first suggestion did the job and your second suggestion looks much more elegant.
I hope to do some other spreadsheet "design" tasks with my VBA code (such as making one column the sum of the values in the previous 3 columns) so this solution might help me there too.
Regards.
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

This article describes two methods for creating a combo box that can be used to add new items to the row source -- one for simple lookup tables, and one for a more complex row source where the new item needs data for several fields.
You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

749 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