How to shorter my macro module ?

[nur2544]

Dear all, I have recorded three macro module for retrieve web data & it works very well, this web data contains stock high & low price ,similarly I need to analysis more about 200 stock for my personal portfolio loss gain calculation. So if I want to retrieve 200 stock , then I need to build up 200 macro record module , which is not wise decision. for this I need to implement looping vba concept as some parameter are same for all Stock , below is the recorded macro module for only three stock.

Sub Macro1()
With Sheets("web")
Sheets("web").Select
.Range("A:A").ClearContents
End With
  
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.exemple.org/companyGraph/cp/yearly/companygraph.php?company=ABBANK" _
        , Destination:=Range("$A$1"))
        .Name = "companygraph.php?company=ABBANK"
        .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
      
  With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.exemple.org/companyGraph/cp/yearly/companygraph.php?company=NBL" _
        , Destination:=Range("$A$7"))
        .Name = "companygraph.php?company=NBL"
        .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
    
With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.exemple.org/companyGraph/cp/yearly/companygraph.php?company=EBL" _
        , Destination:=Range("$A$13"))
        .Name = "companygraph.php?company=NBL"
        .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
End Sub

here red color mark text is the individual stock name & green color text is the excel cell number where web data will be past onwards. however i will be change
just URL link & desire cell range, i need your assistance regarding this , take care every body.. nur

[MarvinP]

Hi nur,

This isn't perfect but can give you an idea of how to loop and use an array and index to shorten your code:
You should also look at the VBA "Split()" function to shorten some of the array stuff. You can leave out the quote marks and make it a little simpler.

Sub Macro1()
Dim StockCtr As Double
Stocks = Array("AABANK", "NBL", "EBL")

With Sheets("web")
Sheets("web").Select
.Range("A:A").ClearContents
End With

For StockCtr = 0 To UBound(Stocks)

    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.exemple.org/companyGraph/cp/yearly/companygraph.php?company=" & Stocks(StockCtr) _
        , Destination:=Range("$A$" & StockCtr + 1))
        .Name = "companygraph.php?company=" & Stocks(StockCtr)
        .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
      
End Sub

[nur2544]

Hi MarvinP,
Thanks for reply, Array solution is best , But i was not sure the limitation of Array where I have 200 stock. I thought my stock List will be remain at one sheet (like sheet name “stock”) , & every time macro will take one after one stock & run the macro as well I assumed this the looping concept ! . what ever it is I just want how minimum time it takes to retrieve data form from web to excel .little bit compiler error fixed by below.

End With
Next StockCtr
End Sub

[nur2544]

Hi MarvinP, now it works fine but , the web data past column A, then Column B, likewise Column C,D,E,F,G,H,I,.... till last stock. but i need the stock price in the column A only. where 6 cell interval there will be new stock price , other than it will be overlapping one stock with other stock.
CELL A1 for stock ABBANK
CELL A7 for stock NBL
CELL A13 for stock EBL
CELL A19 ..
CELL A25 ..
CELL A31 ..
CELL A37 ..
.. ..
.. ..
Till last 200 stock.

[MarvinP]

Hi,

I really need a sample of what you have and what you want to modify my code much. You have two sheets? The first has all stock symbols on it in Col A? You want to build Sheet 2? AND you need it to report back on each 6th row? I simply need a sample. OR Better YET!!!!! Upgrade to 2013 Excel and look at:
http://www.stockodo.com/stock-quotes...h-office-2013/
http://www.free-power-point-template...or-excel-2013/

[nur2544]

Hi MarvinP, yes you are right & your got my point , please check the attachment, where sheet "web" is my desire output results. and sheet "stocklist" is the all stock list from here need to data retrieve for all listed stock.

[nur2544]

Hi MarvinP, How to increase array limitations in VBA , i want to keep 302 stock list in the array , already you have given me an example where i can data retrieve for three stock.

Stocks=Array("1JANATAMF","1STBSRS","1STICB","1STPRIMFMF","2NDICB","3RDICB","4THICB","5THICB","6THICB","7THICB","8THICB", .............. like wise till 302 stock )

i have tried to keep all 302 stock in the array but showing error.need your assistance regarding my issue.

instead of above code can i write like below ?

Stocks = Sheet3.Range("A1:A302")