VBA on excel giving error

Question

I have an excel which runs on following VBA code. Till last month it was working perfect , but now giving error. Please help to sort the problem

Sub SaveData()

    Dim i As Integer

    Clear
    Range("A1").Select

    For i = 1 To 1

        'Range("B4") = Cells(6 + i, 14)
        Range("F3") = "getting " & Range("B4")
        GetData
        Range("C7:Y95").Select
        Selection.Copy

        Sheets("FEED").Select
        Range("A1").Select
        ActiveSheet.Paste
        Sheets("Sheet2").Select

        Columns("Z:AV").Select
        Application.CutCopyMode = False
        Selection.Delete Shift:=xlToLeft
        Sheets("Sheet2").Visible = False

        Sheets("FEED").Visible = False

        Sheets("MAIN").Select
        Range("AA2").Select
        ActiveWorkbook.Connections("Connection").Delete
        ActiveWorkbook.Connections("Connection1").Delete
        '    ActiveWorkbook.Connections("Connection2").Delete
        ' ActiveWorkbook.Connections("Connection3").Delete

        Exit Sub
        Range("I8:I300").Select
        Selection.Copy
        Cells(8, 14 + i).Select
        Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,     SkipBlanks:= _
            False, Transpose:=False
        Range("A1").Select
    Next i
    Range("F3") = ""
    Range("BF1").Select
    UpdateScale
    Colour
    Range("AY5").Select
End Sub

Sub GetData()

    Dim QuerySheet As Worksheet
    Dim DataSheet As Worksheet
    Dim EndDate As Date
    Dim StartDate As Date
    Dim Symbol As String
    Dim qurl As String
    Dim nQuery As Name


    Application.DisplayAlerts = False


    Set DataSheet = ActiveSheet

    StartDate = DataSheet.Range("B2").Value
    EndDate = DataSheet.Range("B3").Value
    Symbol = DataSheet.Range("B4").Value
    Range("C7").CurrentRegion.ClearContents



    qurl="http://www.nseindia.com/live_market/dynaContent/live_watch/option_chain/optionKeys.jsp?symbolCode=1309&symbol=" & Symbol
        qurl = qurl & "&symbol=" & Symbol & "&instrument=-&date=-&segmentLink=17&symbolCount=2&segmentLink=17"


    Range("b5") = qurl

 QueryQuote:
         With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl,     Destination:=DataSheet.Range("C7"))
            .BackgroundQuery = True
            .TablesOnlyFromHTML = False
            .REFRESH BackgroundQuery:=False
            .SaveData = True
        End With
        Exit Sub
        Range("C7").CurrentRegion.TextToColumns Destination:=Range("C7"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=True, Space:=False, other:=False

        Range(Range("C7"), Range("C7").End(xlDown)).NumberFormat = "mmm d/yy"
        Range(Range("D7"), Range("G7").End(xlDown)).NumberFormat = "0.00"
        Range(Range("H7"), Range("H7").End(xlDown)).NumberFormat = "0,000"
        Range(Range("I7"), Range("I7").End(xlDown)).NumberFormat = "0.00"


    With ThisWorkbook
        For Each nQuery In Names
            If IsNumeric(Right(nQuery.Name, 1)) Then
                nQuery.Delete
            End If
        Next nQuery
    End With

    'turn calculation back on
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True
    Range("C7:I2000").Select
    Selection.Sort Key1:=Range("C8"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Range("C1").Select
    Selection.ColumnWidth = 12

    '    UpdateScale

    Range("B4").Select

End Sub

Sub UpdateScale()
    Dim ChartVar As Chart
    Dim lMax As Long, lMin As Long

    On Error GoTo ScalingProblem
    'Assigns the values in the Min and Max ranges to variables.
    With Sheet1
        lMax = .Range("Max").Value
        lMin = .Range("Min").Value
        'Creates chart object.
        Set ChartVar = .ChartObjects("Chart 49").Chart

       With ChartVar.Axes(xlValue, xlPrimary)  'Adjusts the price axis
           .MinimumScale = lMin
           .MaximumScale = lMax
       End With

    End With
    Exit Sub

ScalingProblem:
    'RetrievalProblem:
    '    MsgBox "Unable to update chart scale.", vbCritical + vbOKOnly, "Scaling     Error"
End Sub

Sub Clear()
    '
    ' Clear Macro
    ' Macro recorded 3/13/2006 by Ponzo
    '

    '
    ActiveWindow.SmallScroll ToRight:=6
    Range("O8:X258").Select
    Selection.ClearContents
End Sub

Sub Colour()
    '
    ' Colour Macro
    ' Macro recorded 3/13/2006 by Ponzo

    Dim i As Integer, j As Integer, A As Double, B As Double, C As Double

    A = Range("AZ2")
    'B = Range("BA2")
    C = Range("BB2")

    For i = 1 To 10
        For j = 1 To 10

            If Cells(7 + i, 48 + j) < A Then
                Range("AZ3").Select
                Selection.Copy
                Cells(7 + i, 48 + j).Select
                Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone,     SkipBlanks:= _
                    False, Transpose:=False
            End If

            If (Cells(7 + i, 48 + j) >= A And Cells(7 + i, 48 + j) <= C) Then
                Range("BA3").Select
                Selection.Copy
                Cells(7 + i, 48 + j).Select
                Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone,     SkipBlanks:= _
                    False, Transpose:=False
            End If

            If Cells(7 + i, 48 + j) > C Then
                Range("BB3").Select
                Selection.Copy
                Cells(7 + i, 48 + j).Select
                Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone,     SkipBlanks:= _
                    False, Transpose:=False
            End If
        Next j
    Next i

    For i = 1 To 10
        '    Cells(7 + i, 48 + i) = ""
        Cells(7 + i, 48 + i).Select
        With Selection.Interior
            .ColorIndex = 16
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
        End With
    Next i

    For i = 1 To 10
        For j = 1 To 10

            If Cells(20 + i, 48 + j) < A Then
                Range("AZ3").Select
                Selection.Copy
                Cells(20 + i, 48 + j).Select
                Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone,     SkipBlanks:= _
                    False, Transpose:=False
            End If

            If (Cells(20 + i, 48 + j) >= A And Cells(20 + i, 48 + j) <= C) Then
                Range("BA3").Select
                Selection.Copy
                Cells(20 + i, 48 + j).Select
                Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone,     SkipBlanks:= _
                    False, Transpose:=False
            End If

            If Cells(20 + i, 48 + j) > C Then
                Range("BB3").Select
                Selection.Copy
                Cells(20 + i, 48 + j).Select
                Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone,     SkipBlanks:= _
                    False, Transpose:=False
            End If
        Next j
    Next i

    For i = 1 To 10
        '    Cells(20 + i, 48 + i) = ""
        Cells(20 + i, 48 + i).Select
        With Selection.Interior
            .ColorIndex = 16
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
        End With
    Next i
    Range("AY5").Select
End Sub

Sub REFRESH()
    '
    ' REFRESH Macro
    '

    '
    'Sheets("MAIN").Select
    Sheets("Sheet2").Visible = True
    'Sheets("MAIN").Select
    Sheets("FEED").Visible = True
    Sheets("Sheet2").Select
    SaveData
End Sub

It says can't open http://www.nseindia.com/live_market/dynaContent/live_watch/option and on debug it gives the line .REFRESH BackgroundQuery:=False — jpio chchc, May 30 '16 at 16:33
There is a lot of `Select` or `Selection` in your code, it is not a good practice and can almost always be avoided. See [here](http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros) — Vincent G, May 30 '16 at 16:39
Perhaps the site is down. Try entering the text of qurl into the address bar. — Andy G, May 30 '16 at 16:39
Sir, the website http://www.nseindia.com/live_market/dynaContent/live_watch/option_chain/optionKeys.jsp is working perfect. — jpio chchc, May 30 '16 at 16:45
I believe what @AndyG meant to say is that you should investigate upon the value of `qurl` when the error occurs. Simply use the immediate window with `? qurl`. Then you will get the URL which VBA is trying to access. Then you can copy that URL into a browser to see if it works. Maybe the website has changed the URL you need to use to access the website for a stock. Websites constantly change (don't know why). BTW, the URL AndyG posted is not working for me. Yet, your link is working. But neither link is used in the VBA code. — Ralph, May 30 '16 at 17:52

score 0 · Answer 1 · answered Jun 10 '16 at 01:11

Just Try this

Go to START and in the RUN line type REGEDIT.

b. In the registry navigate to

HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings

c. Right click Internet Settings and left click New > DWORD Value (32-bit) and name the new value “BypassSSLNoCacheCheck” without the quotes. Double click this value and give it a value of 1.

score 0 · Answer 2 · answered Mar 09 '17 at 05:33

Sub SaveData()

Dim i As Integer

Clear
Range("A1").Select

For i = 1 To 1

    'Range("B4") = Cells(6 + i, 14)
    Range("F3") = "getting " & Range("B4")
    GetData
    Range("C7:Y95").Select
    Selection.Copy

    Sheets("FEED").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("Sheet2").Select

    Columns("Z:AV").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Sheets("Sheet2").Visible = False

    Sheets("FEED").Visible = False

    Sheets("MAIN").Select
    Range("AA2").Select
    ActiveWorkbook.Connections("Connection").Delete
    ActiveWorkbook.Connections("Connection1").Delete
    '    ActiveWorkbook.Connections("Connection2").Delete
    ' ActiveWorkbook.Connections("Connection3").Delete

    Exit Sub
    Range("I8:I300").Select
    Selection.Copy
    Cells(8, 14 + i).Select
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Range("A1").Select
Next i
Range("F3") = ""
Range("BF1").Select
UpdateScale
Colour
Range("AY5").Select

End Sub

Sub GetData()

Dim QuerySheet As Worksheet
Dim DataSheet As Worksheet
Dim EndDate As Date
Dim StartDate As Date
Dim Symbol As String
Dim qurl As String
Dim nQuery As Name


Application.DisplayAlerts = False


Set DataSheet = ActiveSheet

StartDate = DataSheet.Range("B2").Value
EndDate = DataSheet.Range("B3").Value
Symbol = DataSheet.Range("B4").Value
Range("C7").CurrentRegion.ClearContents



qurl = "http://www.nseindia.com/live_market/dynaContent/live_watch/option_chain/optionKeys.jsp?symbolCode=1309&symbol=" & Symbol
    qurl = qurl & "&symbol=" & Symbol & "&instrument=-&date=-&segmentLink=17&symbolCount=2&segmentLink=17"


Range("b5") = qurl

QueryQuote: With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("C7")) .BackgroundQuery = True .TablesOnlyFromHTML = False .REFRESH BackgroundQuery:=False .SaveData = True End With Exit Sub Range("C7").CurrentRegion.TextToColumns Destination:=Range("C7"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ Semicolon:=False, Comma:=True, Space:=False, other:=False

    Range(Range("C7"), Range("C7").End(xlDown)).NumberFormat = "mmm d/yy"
    Range(Range("D7"), Range("G7").End(xlDown)).NumberFormat = "0.00"
    Range(Range("H7"), Range("H7").End(xlDown)).NumberFormat = "0,000"
    Range(Range("I7"), Range("I7").End(xlDown)).NumberFormat = "0.00"


With ThisWorkbook
    For Each nQuery In Names
        If IsNumeric(Right(nQuery.Name, 1)) Then
            nQuery.Delete
        End If
    Next nQuery
End With

'turn calculation back on
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Range("C7:I2000").Select
Selection.Sort Key1:=Range("C8"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("C1").Select
Selection.ColumnWidth = 12

'    UpdateScale

Range("B4").Select

End Sub

Sub UpdateScale() Dim ChartVar As Chart Dim lMax As Long, lMin As Long

On Error GoTo ScalingProblem
'Assigns the values in the Min and Max ranges to variables.
With Sheet1
    lMax = .Range("Max").Value
    lMin = .Range("Min").Value
    'Creates chart object.
    Set ChartVar = .ChartObjects("Chart 49").Chart

   With ChartVar.Axes(xlValue, xlPrimary)  'Adjusts the price axis
       .MinimumScale = lMin
       .MaximumScale = lMax
   End With

End With
Exit Sub

ScalingProblem: 'RetrievalProblem: ' MsgBox "Unable to update chart scale.", vbCritical + vbOKOnly, "Scaling Error" End Sub

Sub Clear() ' ' Clear Macro ' Macro recorded 3/13/2006 by Ponzo '

'
ActiveWindow.SmallScroll ToRight:=6
Range("O8:X258").Select
Selection.ClearContents

End Sub

Sub Colour() ' ' Colour Macro ' Macro recorded 3/13/2006 by Ponzo

Dim i As Integer, j As Integer, A As Double, B As Double, C As Double

A = Range("AZ2")
'B = Range("BA2")
C = Range("BB2")

For i = 1 To 10
    For j = 1 To 10

        If Cells(7 + i, 48 + j) < A Then
            Range("AZ3").Select
            Selection.Copy
            Cells(7 + i, 48 + j).Select
            Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
                False, Transpose:=False
        End If

        If (Cells(7 + i, 48 + j) >= A And Cells(7 + i, 48 + j) <= C) Then
            Range("BA3").Select
            Selection.Copy
            Cells(7 + i, 48 + j).Select
            Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
                False, Transpose:=False
        End If

        If Cells(7 + i, 48 + j) > C Then
            Range("BB3").Select
            Selection.Copy
            Cells(7 + i, 48 + j).Select
            Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
                False, Transpose:=False
        End If
    Next j
Next i

For i = 1 To 10
    '    Cells(7 + i, 48 + i) = ""
    Cells(7 + i, 48 + i).Select
    With Selection.Interior
        .ColorIndex = 16
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
    End With
Next i

For i = 1 To 10
    For j = 1 To 10

        If Cells(20 + i, 48 + j) < A Then
            Range("AZ3").Select
            Selection.Copy
            Cells(20 + i, 48 + j).Select
            Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
                False, Transpose:=False
        End If

        If (Cells(20 + i, 48 + j) >= A And Cells(20 + i, 48 + j) <= C) Then
            Range("BA3").Select
            Selection.Copy
            Cells(20 + i, 48 + j).Select
            Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
                False, Transpose:=False
        End If

        If Cells(20 + i, 48 + j) > C Then
            Range("BB3").Select
            Selection.Copy
            Cells(20 + i, 48 + j).Select
            Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
                False, Transpose:=False
        End If
    Next j
Next i

For i = 1 To 10
    '    Cells(20 + i, 48 + i) = ""
    Cells(20 + i, 48 + i).Select
    With Selection.Interior
        .ColorIndex = 16
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
    End With
Next i
Range("AY5").Select

End Sub

Sub REFRESH() ' ' REFRESH Macro '

'
'Sheets("MAIN").Select
Sheets("Sheet2").Visible = True
'Sheets("MAIN").Select
Sheets("FEED").Visible = True
Sheets("Sheet2").Select
SaveData

End Sub

VBA on excel giving error

2 Answers2