VBA Problem

tenspeed2

New Member
Joined
Jan 25, 2011
Messages
47
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
 

Some videos you may like

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.

Watch MrExcel Video

Forum statistics

Threads
1,122,822
Messages
5,598,307
Members
414,224
Latest member
Crazy_FC

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
Top