Sub GetHistoricalData()
Dim LastRowC As Integer
Dim Rng As Range
Dim LastCol As Integer
Dim i As Integer
Dim ShtDashboard As Worksheet
Dim ShtHistoricalData As Worksheet
Set ShtDashboard = ThisWorkbook.Sheets("Dashboard")
Set ShtHistoricalData = ThisWorkbook.Sheets("Historical Data")
ShtHistoricalData.Columns(1).Resize(, 16000 - (1 - 1)).ColumnWidth = 15
Range(ShtHistoricalData.Cells(1, 1), ShtHistoricalData.Cells(1000, 16000)).ClearContents
Set Rng = Range(ShtHistoricalData.Cells(1, 1), ShtHistoricalData.Cells(1000, 16000)) '1000 is random row number, it is enough for 30 days of data, I may pull more data, but unlikely more than 1000 days; 16000 is random column number, there are 16384 columns on a worksheet.
LastRowC = ShtDashboard.Cells(Rows.Count, "C").End(xlUp).Row 'I have a list of symbol in column C, less than 2000 companies, above random number 16000 is enough
For i = 2 To LastRowC
LastCol = Last(2, Rng)
If LastCol < 1 Then
ShtHistoricalData.Cells(1, 1).Value = ShtDashboard.Cells(i, 3).Value
ShtHistoricalData.Cells(2, 1).Formula2 = "=STOCKHISTORY(" & """" & ShtHistoricalData.Cells(1, 1).Value & """" & ",TODAY()-30,TODAY())"
Else
ShtHistoricalData.Cells(1, LastCol + 3).Value = ShtDashboard.Cells(i, 3).Value
ShtHistoricalData.Cells(2, LastCol + 3).Formula2 = "=STOCKHISTORY(" & """" & ShtHistoricalData.Cells(1, LastCol + 3).Value & """" & ",TODAY()-30,TODAY())"
End If
Next i
MsgBox "Done"
End Sub
Function Last(choice As Long, Rng As Range)
' 1 = last row
' 2 = last column
' 3 = last cell
Dim lrw As Long
Dim lcol As Long
Select Case choice
Case 1:
On Error Resume Next
Last = Rng.Find(What:="*", _
after:=Rng.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
Case 2:
On Error Resume Next
Last = Rng.Find(What:="*", _
after:=Rng.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
Case 3:
On Error Resume Next
lrw = Rng.Find(What:="*", _
after:=Rng.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
On Error Resume Next
lcol = Rng.Find(What:="*", _
after:=Rng.Cells(1), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
On Error Resume Next
Last = Rng.Parent.Cells(lrw, lcol).Address(False, False)
If Err.Number > 0 Then
Last = Rng.Cells(1).Address(False, False)
Err.Clear
End If
On Error GoTo 0
End Select
End Function
Bookmarks