VBA Run-time error '1004'

Question

I'm trying to get data that is produced from a SQL Stored Procedure to be appended on to the end of existing data within my excel spreadsheet using VBA. I want it pasted to the right of the last column. Each time I run it i get the error above: "Method 'Range' of object '_Global' failed.

I would like the new data pasted into row 3 to the right of the existing data. Below is my vba code:

Sub RefreshStatus()
    Dim db As DAO.Database
    Dim con As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim rs As ADODB.Recordset
    Dim StoredProc As String
    Dim RWS As Worksheet
    Dim DWS As Worksheet
    Dim ServerName As String
    Dim DatabaseName As String
    Dim StoredProcedure As String

    Set con = New ADODB.Connection
    Set cmd = New ADODB.Command
    Set rs = New ADODB.Recordset
    Set RWS = Worksheets("Refresh")
    Set DWS = Worksheets("141215")




    Application.DisplayStatusBar = True
    Application.StatusBar = "Contacting SQL Server..."


    RWS.Activate

    ServerName = "tns-reports-01" ' Enter your server name here
    DatabaseName = "GroupPerformance" ' Enter your database name here
    StoredProcedure = "JM_Recruitment_Status_141215" ' Enter Stored Procedure here

    con.Open "Provider=SQLOLEDB;Data Source=" & ServerName & ";Initial Catalog=" & DatabaseName & ";Trusted_Connection=yes"
    cmd.ActiveConnection = con


    Application.StatusBar = "Running stored procedure..."
    cmd.CommandTimeout = 0
    cmd.CommandText = StoredProcedure
    Set rs = cmd.Execute(, , adCmdStoredProc)


     ' Copy the results to cell A1 on the first Worksheet
    DWS.Activate

    Dim Lastcol As Long

    Lastcol = Range("3" & Columns.Count).End(xlRight).Row

    If rs.EOF = False Then DWS.Cells(2, 1).CopyFromRecordset rs



    rs.Close
    Set rs = Nothing
    Set cmd = Nothing


    con.Close
    Set con = Nothing

    Application.StatusBar = "Data successfully updated."

End Sub

If anybody could help me out, I would greatly appreciate it.

Many thanks.

mielk mielk · Accepted Answer · 2015-12-18T11:52:59

You made some errors when trying to find the last non-empty column and some other minor errors.

Below is your code with a few changes (changes are described in comments).

I have assumed that your recordset contains only one field and many records and you want to paste all those records horizontally from cell _3 to the right where _ is the first empty column.

Sub RefreshStatus()
    Dim db As DAO.Database
    Dim con As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim rs As ADODB.Recordset
    Dim StoredProc As String
    Dim RWS As Worksheet
    Dim DWS As Worksheet
    Dim ServerName As String
    Dim DatabaseName As String
    Dim StoredProcedure As String

    Set con = New ADODB.Connection
    Set cmd = New ADODB.Command
    Set rs = New ADODB.Recordset
    Set RWS = Worksheets("Refresh")
    Set DWS = Worksheets("141215")



    With Application
        .DisplayStatusBar = True
        .StatusBar = "Contacting SQL Server..."
    End With


    'NOTE: You don't have to activate worksheet to operate on its ranges.
    'Actually, you shouldn't do that, since it's time-consuming, make the
    'user experience worst and can cause errors in specific cases.
    'Additionaly, I can't see where you use RWS worksheet later in the code.
    'RWS.Activate

    ServerName = "tns-reports-01" ' Enter your server name here
    DatabaseName = "GroupPerformance" ' Enter your database name here
    StoredProcedure = "JM_Recruitment_Status_141215" ' Enter Stored Procedure here

    con.Open "Provider=SQLOLEDB;Data Source=" & ServerName & ";Initial Catalog=" & DatabaseName & ";Trusted_Connection=yes"
    cmd.ActiveConnection = con


    Application.StatusBar = "Running stored procedure..."
    cmd.CommandTimeout = 0
    cmd.CommandText = StoredProcedure
    Set rs = cmd.Execute(, , adCmdStoredProc)


    ' Copy the results to cell A1 on the first Worksheet
    'Again, it is not necessary to activate worksheet.
    'DWS.Activate


    Dim lastCol As Long


    'If rs.EOF = False Then DWS.Cells(2, 1).CopyFromRecordset rs
    row = 3
    lastCol = DWS.Cells(row, DWS.Columns.Count).End(xlRight).Column + 1
    Do Until rs.EOF
        DWS.Cells(row, lastCol).value = rs.Fields(0).value
        row = row + 1
        Call rs.MoveNext
    Loop



    rs.Close
    Set rs = Nothing
    Set cmd = Nothing


    con.Close
    Set con = Nothing

    Application.StatusBar = "Data successfully updated."

End Sub

VBA Run-time error '1004'

1 Answers