Code which runs OK if stepped through .....

[RichardMGreen]

but fails with an error if I just try to run it.

I have the following code :-

Sub Import_data()
    Dim conn As ADODB.Connection, rs As ADODB.Recordset, cmd As ADODB.Command
    Dim wsData As Worksheet, wsDst As Worksheet, ws As Worksheet, wb As Workbook
    Dim rngData As Range, rngDst As Range, qt As QueryTable
    Dim strQry As String, strSQL As String, file As String, strConn As String
'----- Check if data retrieval should be bypassed - if so, go straight to file creation -----
    If Sheets("Control").Range("D5") <> "Y" Then
        Set wsData = Worksheets("SQL Data")
        file = wsData.Range("G2")
'----- Clear out old data and set up userform -----
        maxquery = Sheets("SQL Data").Range("A65535").End(xlUp).Row - 1
        currentquery = 0
        UserForm1.Show
        UserForm1.Label1.Caption = "Refreshing Database Queries..."
        UserForm1.ProgressBar1.Value = 0
        UserForm1.Repaint
'----- Turn off calculations and clear current data -----
        Application.Calculation = xlCalculationManual
        Sheets("IntradayData").Rows("4:10000").ClearContents
        Sheets("DailyData").Rows("4:10000").ClearContents
        Sheets("CallDetail").Rows("4:10000").ClearContents
'----- Get all data -----
        Set conn = New ADODB.Connection
        strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & file & ";Persist Security Info=False;"
        conn.ConnectionString = strConn
        conn.Open
        Set rngData = wsData.Range("A2")
        Set cmd = New ADODB.Command
        On Error GoTo error_line
        While rngData.Value <> ""
            strQry = "[" & rngData.Value & "]"
            strSQL = "SELECT * FROM " & strQry
            offsetrow = 1
            cmd.CommandType = adCmdText
            cmd.CommandText = strSQL
            cmd.ActiveConnection = conn
'----- Pick up information on where data is to go -----
            Set wsDst = Worksheets(rngData.Offset(, 1).Value)
            Set rngDst = wsDst.Range(rngData.Offset(, 2).Value)
'----- Retrieve data from database and insert into correct cells -----
            Set rs = cmd.Execute
            If Not IsNull(rngDst) Then rngDst.CopyFromRecordset rs
            currentquery = currentquery + 1
'----- Make sure no data left to write and set up details for next query -----
error_line:
            Err.Clear
            On Error GoTo error_line
            Set rs = Nothing
            Set rngData = rngData.Offset(offsetrow)
            UserForm1.ProgressBar1.Value = (currentquery / (maxquery + 1)) * 100
            UserForm1.Repaint
        Wend
        Set conn = Nothing
'----- Adjust formulas on data sheets as necessary -----
        Sheets("IntradayData").Select
        Range("K3:L3").Copy
        lastrow = Range("J65535").End(xlUp).Row + 1
        Range("K4:K" & lastrow).PasteSpecial (xlPasteAll)
        Range("A1").Select

        Sheets("IntradayData").Select
        Range("BL3:BN3").Copy
        lastrow = Range("BK65535").End(xlUp).Row + 1
        Range("BL4:BL" & lastrow).PasteSpecial (xlPasteAll)
        Range("A1").Select

        Sheets("DailyData").Select
        Range("AY3:BD3").Copy
        lastrow = Range("AX65535").End(xlUp).Row + 1
        Range("AY4:AY" & lastrow).PasteSpecial (xlPasteAll)
        Range("A1").Select
'----- Save template with refreshed data -----
        Sheets("Control").Select
        ActiveWorkbook.Save
    End If
'----- Create final output file -----
    If UserForm1.Visible = False Then UserForm1.Show
    On Error GoTo dropout
    UserForm1.Label1.Caption = "Creating Output..."
    UserForm1.ProgressBar1.Value = ((currentquery + 1) / (maxquery + 1)) * 100
    UserForm1.Repaint
    Application.Calculate
'----- Create new workbook for output and set calculations to automatic -----
    Set wb = Workbooks.Add
    ThisWorkbook.Sheets(Array("National View", "NE Report", "All Luton", "Luton Report", "Luton 111", _
        "E Mids", "All Nott", "Nott OOH Report", "Nott 111 Report", "Lincoln Report", "ChartData32Days", _
        "FRONT", "Definitions")).Copy After:=wb.Sheets(3)
    Application.DisplayAlerts = False
    wb.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
    break_link_name = ThisWorkbook.Path & "\" & ThisWorkbook.Name
    wb.BreakLink Name:=break_link_name, Type:=xlExcelLinks
    Application.DisplayAlerts = True
'----- Create values-only copy of sheets -----
    For Each ws In wb.Worksheets
        ws.Select
        Cells.Copy
        Cells.PasteSpecial (xlPasteValues)
        Range("A1").Select
    Next
    wb.Sheets("ChartData32Days").Visible = False
    wb.Sheets("Front").Select
'----- Set up variables for saving report -----
    ReportingDate = Format(ThisWorkbook.Sheets("Control").Range("D2").Value, " yyyy-mm-dd")
    OutputLocation = ThisWorkbook.Sheets("Control").Range("D3")
    SaveName = ThisWorkbook.Sheets("Control").Range("D4")
    Vsion = 1
'----- Save new workbook with version control -----
    Do While FileExists(OutputLocation & SaveName & ReportingDate & " v" & Vsion & ".xls")
        Vsion = Vsion + 1
    Loop
    Application.Calculation = xlCalculationAutomatic
    wb.SaveAs Filename:=OutputLocation & SaveName & ReportingDate & " v" & Vsion & ".xls"
    wb.Close False
'----- Select first cell on each visible sheet -----
    Application.ScreenUpdating = False
    For Each ws In Worksheets
        If ws.Visible = xlSheetVisible Then
            ws.Select
            Range("A1").Select
        End If
    Next
    Sheets("Control").Select
    Application.ScreenUpdating = True
    Unload UserForm1
    If currentquery < maxquery Then
        response = MsgBox("Not all queries have successfully updated" & Chr(10) & _
            "Please rerun this macro", vbOKOnly, "XXX WARNING XXX")
    End If
    Exit Sub
dropout:
    response = MsgBox("Problem occurred creating output file" & Chr(10) & _
        "Please rerun this macro after changing 'Bypass data refresh?' to Y", vbOKOnly, "XXX WARNING XXX")
End Sub

If I step through the code, it works fine and reacts as expected (including breaking the links when creating the output file).
However, if I just run the macro from the button on the "Control" sheet, it fails on this line:-

wb.BreakLink Name:=break_link_name, Type:=xlExcelLinks

and jumps to the dropout section.

Can anyone explain why or how I can reset the "On Error" so I get a proper error message if it fails?

 

[RSXchin]

Add watches to ALL of your variables just to see if they are changing how you want.

 

[RichardMGreen]

Already checked and everything's changing as expected.
If I could get this one line to work properly, then I can move on to the next task.

 

[RSXchin]

2 answers....
1!!! try adding an application.wait timer for a second or so just before that line OR
2!!! add in a message box or something asking if they want to continue.


both are very dirty workarounds, but if they work...

 

[RichardMGreen]

Put in a one second delay before the breaklinks and it appears to have worked.
Just run the code twice without stepping through it and no error messages and all links are broken on the output file.

Thanks for the help.

 

[RSXchin]

(I had NO idea that would work...)

 

[Norie]

Richard

Have you tried the code without the userform?

Or with the form but not the progress bar stuff?