General Macro Assistance Request

streptoman · Jun 6, 2019

Hello all,
First post for me here (…anywhere, rather), but I'm hoping someone might be able to assist with the following.
I have no programming experience, and frankly pilfered all of this code from the internet a couple of years ago.
I have noted that this subroutine will randomly add 4 columns to the worksheet, around the fourth iteration. Could it be a fault at the source of the data? This code seems to function properly on most runs.
I imagine that the code is quite messy, I do apologize, but any assistance in determining why these columns are added (and adversely affecting the following iteration), is greatly appreciated.

Code:

Sub GetNextDay()
    Worksheets("Today").Select
    Worksheets("Today").Activate
 
Dim row As Integer
 
For row = 2 To 11
 
With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://money.cnn.com/quote/quote.html?symb=" & Cells(row, 7).Value, Destination:=Range("$A$18"))
        '.CommandType = 0
        .Name = "quote.html?symb=HWAY" ‘does this have any significance? The value is random
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
DoEvents
    Columns("A:A").Select
    Selection.Find(What:="Set Alert", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
    ActiveCell.Offset(1, 0).Select
If Not IsNumeric(ActiveCell.Value) Then ActiveCell.Offset(1, 0).Select
    Selection.Copy
    Cells(row, 8).Select
    ActiveSheet.Paste
    DoEvents
    'Columns("A:A").Select
    'Selection.Find(What:="Volume", After:=ActiveCell, LookIn:=xlFormulas, _
     '   LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
      '  MatchCase:=False, SearchFormat:=False).Activate
    'ActiveCell.Offset(0, 1).Select
    'Selection.Copy
    'Cells(row, 10).Select
    'ActiveSheet.Paste
   
    Range("A18:F300").ClearContents
   
    On Error Resume Next
DoEvents
Next row
On Error Resume Next
 
End Sub

JLGWhiz · Jun 6, 2019

I don't see anything in the copy/paste portion of the code that would generate additional columns, so it must be happening in a refresh cycle from the web.

General Macro Assistance Request

streptoman

New Member

Excel Facts

JLGWhiz

Well-known Member

Similar threads

Forum statistics

Share this page

General Macro Assistance Request

streptoman

New Member

Excel Facts

JLGWhiz

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock