VBA Problem

tenspeed2

Board Regular
Joined
Jan 25, 2011
Messages
56
A person that is not longer around sent me the following VBA. When I first ran the code it worked until the web page was updated, now the code does not work.
The following is what the code should do. When I start the macro it would go to the website, enter in the first symbol then go to the DISTRIBUTION TAB.retrive
the first line of data under the DISTRIBUTION HISTORY HEADING which is the dates and the amount of dividends on the first line, then return the data to Excel
ss in columns B:I, then repeat the process for the next symbol which is in column A until it loops thru all 600 symbols. If you could look at the VBA and explain
what has happened I would appreciate it greatly as i use this as part of my research.
Max
Public Declare Function DeleteUrlCacheEntry Lib "Wininet.dll" _
Alias "DeleteUrlCacheEntryA" _
(ByVal lpszUrlName As String) As Long

Public Sub getData()
Dim x As String
Dim y As Variant
Dim n As Integer

Dim rngSymbols As Range
Dim sym As Range
Dim mydata As Variant

Dim xmlhttp As Object
Dim theData()
Dim strURL As String

ActiveSheet.Range("b:z").ClearContents
Application.ScreenUpdating = False
Set xmlhttp = CreateObject("microsoft.xmlhttp")

Set rngSymbols = Range("Symbols")
For Each sym In rngSymbols
Application.StatusBar = "Processing: " & sym.Value & " | Row: " & sym.Row - 2 & " / " & rngSymbols.Rows.Count

strURL = "http://www.cefconnect.com/Details/Summary.aspx?ticker=" & sym.Value
DeleteUrlCacheEntry (strURL)

With xmlhttp
.Open "get", strURL, False
.send
x = .responsetext
End With

'parse down the response text to the one row fo the table you need

If InStr(1, x, "ctl000_contents_SummaryContainer_DistributionsTab_ucDistributions_gvMain_ctl01_ROCHeader") = 0 Then
x = ">Not Found</td>"
Else
x = Mid(x, InStr(1, x, "ctl00_contents_SummaryContainer_DistributionsTab_ucDistributions_gvMain_ctl01_ROCHeader"))
x = Mid(x, InStr(1, x, "</tr>") + 5)
x = Mid(x, 1, InStr(1, x, "</tr>"))
End If

'split the row into its elements
y = Split(x, "</td>")

ReDim theData(UBound(y))

'put each data element into an array
For n = 0 To UBound(y)
theData(n) = Mid(y(n), InStrRev(y(n), ">") + 1)
If theData(n) = 0 Then theData(n) = ""
Next n

sym.Offset(0, 1).Resize(1, UBound(theData)) = theData

Next sym

ActiveSheet.UsedRange.Columns.AutoFit
Application.StatusBar = False
Application.ScreenUpdating = True

Set xmlhttp = Nothing
End Sub
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.

Forum statistics

Threads
1,214,920
Messages
6,122,267
Members
449,075
Latest member
staticfluids

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top