Saturday, March 25, 2017

Tuesday, March 7, 2017

from a list of companies calculate for each company the logarithmic daily return using yahoo finance and vba,vba teacher sourav,kolkata 09748184075




Option Explicit

Private Sub test_portfolio()
Application.DisplayAlerts = False
On Error Resume Next
Workbooks("table.csv").Close
Workbooks("Part3.xlsm").Activate
   Dim Symbol As String
   Dim StartDate As Date
   Dim EndDate As Date
   
   
   
   Dim StartDay As Integer
   Dim StartMonth As Integer
   Dim StartYear As Integer
   Dim EndDay As Integer
   Dim EndMonth As Integer
   Dim tempdateval As Date
   Dim previousclosingrate As Date
   
   Dim EndYear As Integer
   Dim closingrate As Double
   
   Dim URL As String
   Dim temppos As String
   
  Sheets("Portfolio").Select
  Range("A2").Select
  
   temppos = Replace(ActiveCell.Address, "$", "")
   Range(temppos).Select
   While ActiveCell.Value <> ""
   temppos = Replace(ActiveCell.Address, "$", "")
   tempdateval = CDate(ActiveCell.Offset(0, 3).Value)
   
   
     Symbol = ActiveCell.Value
     ActiveCell.Offset(0, 3).Select
     
     
     

     StartDate = CDate(ActiveCell.Value)
     
     EndDate = CDate(ActiveCell.Value)
     
     
On Error GoTo 0
'StartDate = CDate(StartDate - 1)

     StartDay = Day(StartDate)
     
     StartMonth = Month(StartDate) - 1
     
     
     StartYear = Year(StartDate)
     
     EndDay = Day(EndDate)
     
     
     EndMonth = Month(EndDate) - 1
          
     EndYear = Year(EndDate)

     URL = "http://real-chart.finance.yahoo.com/table.csv?s=" _
     & Symbol & "&d=" & EndMonth & "&e=" & EndDay & "&f=" & EndYear _
     & "&g=d&a=" & StartMonth & "&b=" & StartDay & "&c=" _
     & StartYear & "&ignore=.csv"
     
     
    ' MsgBox URL
     On Error Resume Next
     
     Workbooks.Open (URL)
       If Err.Number <> 0 Then
       GoTo comingback
       Else
       
     Cells(1, 1).CurrentRegion.Copy
     
     'Workbooks("Assets.xlsm").Activate
     
     Sheets.Add After:=Sheets(Sheets.Count)

     ActiveSheet.Name = Symbol

     ActiveSheet.Paste

     Columns(1).AutoFit
Application.CutCopyMode = False

  Workbooks("table.csv").Activate
  
  Range("E2").Select
  Selection.Copy
  Workbooks("Part3.xlsm").Activate
  Sheets("Portfolio").Select
  Range(temppos).Select
  ActiveCell.Offset(0, 4).Select
  
  
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
closingrate = CDbl(ActiveCell.Value)
ActiveCell.Value = 1

ActiveCell.Value = closingrate * (ActiveCell.Offset(0, -2).Value)
ActiveCell.Select
Selection.NumberFormat = "0.00;[Red]0.00"

Workbooks("table.csv").Activate
On Error Resume Next
ActiveWorkbook.Close
End If
 Call lastclosingrate(temppos, closingrate)

comingback:

Workbooks("Part3.xlsm").Activate
Range(temppos).Select
ActiveCell.Offset(1, 0).Select
temppos = Replace(ActiveCell.Address, "$", "")

Wend

Application.DisplayAlerts = True

End Sub

Sub lastclosingrate(ByVal temppos As String, ByVal closingratefirst As Double)

On Error Resume Next
Workbooks("table.csv").Close
Workbooks("Part3.xlsm").Activate
   Dim Symbol As String
   Dim StartDate As Date
   Dim EndDate As Date
   
   
   
   Dim StartDay As Integer
   Dim StartMonth As Integer
   Dim StartYear As Integer
   Dim EndDay As Integer
   Dim EndMonth As Integer
   Dim tempdateval As Date
   Dim previousclosingrate As Date
   
   Dim EndYear As Integer
   Dim closingratesecond As Double
   
   Dim URL As String
   'Dim temppos As String
   
  Sheets("Portfolio").Select
  
   Range(temppos).Select
  
   tempdateval = CDate(ActiveCell.Offset(0, 3).Value)
   
   
     Symbol = ActiveCell.Value
     ActiveCell.Offset(0, 3).Select
     
     
     

     StartDate = CDate(ActiveCell.Value) - 1
     
     EndDate = CDate(ActiveCell.Value) - 1
     
     
     
On Error GoTo 0
'StartDate = CDate(StartDate - 1)

     StartDay = Day(StartDate)
     
     StartMonth = Month(StartDate) - 1
     
     
     StartYear = Year(StartDate)
     
     EndDay = Day(EndDate)
     
     
     EndMonth = Month(EndDate) - 1
          
     EndYear = Year(EndDate)

     URL = "http://real-chart.finance.yahoo.com/table.csv?s=" _
     & Symbol & "&d=" & EndMonth & "&e=" & EndDay & "&f=" & EndYear _
     & "&g=d&a=" & StartMonth & "&b=" & StartDay & "&c=" _
     & StartYear & "&ignore=.csv"
     
     
    ' MsgBox UR
     
     Workbooks.Open (URL)
       If Err.Number <> 0 Then
       GoTo comingback
       Else
       
     Cells(1, 1).CurrentRegion.Copy
     
     'Workbooks("Assets.xlsm").Activate
     
     Sheets.Add After:=Sheets(Sheets.Count)

     ActiveSheet.Name = Symbol

     ActiveSheet.Paste

     Columns(1).AutoFit
Application.CutCopyMode = False

  Workbooks("table.csv").Activate
  
  Range("E2").Select
  closingratesecond = CDbl(ActiveCell.Value)
  Selection.Copy
  Workbooks("Part3.xlsm").Activate
  Sheets("Portfolio").Select
  Range(temppos).Select
  ActiveCell.Offset(0, 5).Select
  
  
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   If closingratefirst <> 0 And closingratesecond <> 0 Then
   ActiveCell.Value = (closingratefirst / closingratesecond)
   Else
   ActiveCell.Value = "Not available"
   End If
   
   

ActiveCell.Select
Selection.NumberFormat = "0.00;[Red]0.00"

Workbooks("table.csv").Activate
On Error Resume Next
ActiveWorkbook.Close
End If

comingback:

Workbooks("Part3.xlsm").Activate
Range(temppos).Select

  


End Sub

Sunday, March 5, 2017

get stock data for a given date for a list of companies from yahoo finance api(historical data) using vba,vba teacher sourav,kolkata 09748184075

Option Explicit

Private Sub test_portfolio()
Application.DisplayAlerts = False
On Error Resume Next
Workbooks("table.csv").Close
Workbooks("Part3.xlsm").Activate
   Dim Symbol As String
   Dim StartDate As Date
   Dim EndDate As Date
   
   
   
   Dim StartDay As Integer
   Dim StartMonth As Integer
   Dim StartYear As Integer
   Dim EndDay As Integer
   Dim EndMonth As Integer
   Dim tempdateval As Date
   
   Dim EndYear As Integer
   Dim closingrate As Double
   
   Dim URL As String
   Dim temppos As String
   
  Sheets("Portfolio").Select
  Range("A2").Select
  
   temppos = Replace(ActiveCell.Address, "$", "")
   Range(temppos).Select
   While ActiveCell.Value <> ""
   temppos = Replace(ActiveCell.Address, "$", "")
   tempdateval = CDate(ActiveCell.Offset(0, 3).Value)
   
   
     Symbol = ActiveCell.Value
     ActiveCell.Offset(0, 3).Select
     
     
     

     StartDate = CDate(ActiveCell.Value)
     
     EndDate = CDate(ActiveCell.Value)
     
     
On Error GoTo 0
'StartDate = CDate(StartDate - 1)

     StartDay = Day(StartDate)
     
     StartMonth = Month(StartDate) - 1
     
     
     StartYear = Year(StartDate)
     
     EndDay = Day(EndDate)
     
     
     EndMonth = Month(EndDate) - 1
          
     EndYear = Year(EndDate)

     URL = "http://real-chart.finance.yahoo.com/table.csv?s=" _
     & Symbol & "&d=" & EndMonth & "&e=" & EndDay & "&f=" & EndYear _
     & "&g=d&a=" & StartMonth & "&b=" & StartDay & "&c=" _
     & StartYear & "&ignore=.csv"
     
     
    ' MsgBox URL
     On Error Resume Next
     
     Workbooks.Open (URL)
       If Err.Number <> 0 Then
       GoTo comingback
       Else
       
     Cells(1, 1).CurrentRegion.Copy
     
     'Workbooks("Assets.xlsm").Activate
     
     Sheets.Add After:=Sheets(Sheets.Count)

     ActiveSheet.Name = Symbol

     ActiveSheet.Paste

     Columns(1).AutoFit
Application.CutCopyMode = False

  Workbooks("table.csv").Activate
  
  Range("E2").Select
  Selection.Copy
  Workbooks("Part3.xlsm").Activate
  Sheets("Portfolio").Select
  Range(temppos).Select
  ActiveCell.Offset(0, 4).Select
  
  
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   
closingrate = CDbl(ActiveCell.Value)
ActiveCell.Value = 1

ActiveCell.Value = closingrate * (ActiveCell.Offset(0, -2).Value)
ActiveCell.Select
Selection.NumberFormat = "0.00;[Red]0.00"

Workbooks("table.csv").Activate
On Error Resume Next
ActiveWorkbook.Close
End If

comingback:

Workbooks("Part3.xlsm").Activate
Range(temppos).Select
ActiveCell.Offset(1, 0).Select
temppos = Replace(ActiveCell.Address, "$", "")

Wend

End Sub

Saturday, March 4, 2017

VBA code to download stock information from yahoo finance for a selected company in a listbox,the output should consist date open ,high ,low ,close ,volume ,adj close

Option Explicit

Private Sub CommandButton1_Click()

   Dim Symbol As String
   Dim StartDate As Date
   Dim EndDate As Date
   Dim StartDay As Integer
   Dim StartMonth As Integer
   Dim StartYear As Integer
   Dim EndDay As Integer
   Dim EndMonth As Integer
   Dim EndYear As Integer
   
   Dim URL As String
   
   If ListBox1.ListIndex <> -1 Then
   
     Symbol = ListBox1.Text
     
 On Error GoTo IncorrectDates
     
     StartDate = TextBox1.Text
     EndDate = TextBox2.Text
     
On Error GoTo 0

     StartDay = Day(StartDate)
     StartMonth = Month(StartDate) - 1
     StartYear = Year(StartDate)
     
     EndDay = Day(EndDate)
     EndMonth = Month(EndDate) - 1
     EndYear = Year(EndDate)

     URL = "http://real-chart.finance.yahoo.com/table.csv?s=" _
     & Symbol & "&d=" & EndMonth & "&e=" & EndDay & "&f=" & EndYear _
     & "&g=d&a=" & StartMonth & "&b=" & StartDay & "&c=" _
     & StartYear & "&ignore=.csv"
     
     MsgBox URL
     
     Workbooks.Open (URL)

     Cells(1, 1).CurrentRegion.Copy
     
     'Workbooks("Assets.xlsm").Activate
     
     Sheets.Add after:=Sheets(Sheets.Count)

     ActiveSheet.Name = Symbol

     ActiveSheet.Paste

     Columns(1).AutoFit
Application.CutCopyMode = False

   Else
   
     MsgBox "Select something in the list"
     
   End If
   
   Exit Sub
   
IncorrectDates:

   MsgBox "Incorrect dates"


End Sub

Private Sub CommandButton2_Click()
'Dim cell As Range

    'Sheets("Companies").Select

    'For Each cell In Range(Cells(2, 1), Cells(2, 1).End(xlDown))
    
   '   Me.ListBox1.AddItem cell.Value

    '  Me.ListBox1.List(ListBox1.ListCount - 1, 1) = cell.Offset(0, 1).Value

    'Next cell
    

    
End Sub

Private Sub ListBox1_Click()

End Sub

Private Sub UserForm_Activate()

    

End Sub

Private Sub UserForm_Initialize()

End Sub