Extract multiple data from one sheet to another

V

vishu

Board Regular
Joined
Oct 26, 2011
Messages
70
Office Version
  1. 2016
Platform
  1. Windows
Hello everyone,
Let me try to explain you all
I have a "Download" sheet Column "A" has Stocklist when am clicking the "Download All" button it extracts all stock data and the Last 5 days' data shows to K5:P10 and that data copy and paste to the "Calculation" sheet Column "A:F" which also getting paste.

But here my problem start

The "Download" Sheet doing its job perfectly but the "calculation" sheet does not paste correctly, only the last stock pastes fully 5 days of data and the rest only pastes 1 day of data. This is incorrect 5 days of data for each stock need to be pasted into the "calculation" sheet.

Thanks in advance

below providing VBA code for your reference. please help me to solve this problem.

VBA Code: 
'Copyright 2008-2018 ConnectCode Pte Ltd. All Rights Reserved.
'This source code is protected by International Copyright Laws.
Dim gError As Integer

Sub GetData()
'   thanks to Ron McEwan :^)

    Dim QuerySheet As Worksheet
    Dim DataSheet As Worksheet
    Dim SYMBOL As String
    Dim i As Integer, N As Integer, pct As Double
    

    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationAutomatic
    
    Set DataSheet = ActiveSheet

    N = Range("C1")

    Clear                           ' clear old data
    Init                            ' paste headings
' ----------------------------------


For i = 1 To N
    
    Range("A1") = i
    Range("B4") = Cells(i + 7, 1)  ' get symbol
    Cells(i + 7, 1).Select
    
      Call GetOne(Worksheets("Download").Range("$B$4"), Worksheets("Download").Range("$B$2"), Worksheets("Download").Range("$B$3"), "$A$1", freqFlag)
                          ' download one stock
    
   Application.ScreenUpdating = False
   
    Range("K5:P10").Select           ' collect calculations
    Selection.Copy
       
    Sheets("Calculations").Select      ' move to Calculations sheet
    Cells(i + 2, 1).Select      ' select proper row and paste calculations
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Sheets("Download").Select           ' move to Data sheet
    
    Application.ScreenUpdating = True
    
Next i

    Range("A1").Select
    Selection.ClearContents

    Sheets("Calculations").Select
    Formats
    Range("C1").Select

End Sub

Sub GetOne(ByVal SYMBOL As String, ByVal startDate As Date, ByVal endDate As Date, ByVal desti As String, ByVal freq As String)
    
    On Error GoTo ErrHandler:
    
    Dim crumb               As String
    Dim cookie               As String
    Dim response               As String
    Dim strUrl As String
    Dim DownloadURL As String
    Dim period1, period2 As String
    Dim httpReq As WinHttp.WinHttpRequest
    Dim nQuery As Name

    Set httpReq = New WinHttp.WinHttpRequest
    
    DownloadURL = "https://finance.yahoo.com/lookup?s=" & SYMBOL
    With httpReq
        .Open "GET", DownloadURL, False
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
        .send
        .waitForResponse
        response = .ResponseText
        cookie = Split(.getResponseHeader("Set-Cookie"), ";")(0)
    End With

    period1 = (startDate - DateValue("January 1, 1970")) * 86400
    period2 = (endDate - DateValue("January 1, 1970")) * 86400
    
    Dim counter As Long
    Dim startCounter As Long
    Dim result As String
    Dim dataResult As String
    Dim startResult As String
        
    crumb = Chr(34) & "CrumbStore" & Chr(34) & ":{" & Chr(34) & "crumb" & Chr(34) & ":" & Chr(34)
    startCounter = InStr(response, crumb) + Len(crumb)
    While Mid(response, startCounter, 1) <> Chr(34)
        result = result & Mid(response, startCounter, 1)
        startCounter = startCounter + 1
    Wend
    
    crumb = result
    DownloadURL = "https://query1.finance.yahoo.com/v7/finance/download/" & SYMBOL & "?period1=" & period1 & "&period2=" & period2 & "&interval=" + freq + "&events=history&crumb=" & crumb
    
    startResult = ""
    startCounter = 0
    While (startResult <> "Date" And startCounter < 8)
        With httpReq
            .Open "GET", DownloadURL, False
            .setRequestHeader "Cookie", cookie
            .send
            .waitForResponse
            dataResult = .ResponseText
        End With
        startResult = Mid(dataResult, 1, 4)
        startCounter = startCounter + 1
    Wend
    
    If (startResult <> "Date") Then
        noErrorFound = 0
        GoTo ErrHandler
    End If
    
    dataResult = Replace(dataResult, ",", vbTab)

    Dim dataObj As New DataObject
    dataObj.SetText dataResult
    dataObj.PutInClipboard
            
    Set currentWorksheet = ThisWorkbook.ActiveSheet
    Set currentRange = currentWorksheet.Range("C7")
    dataObj.GetFromClipboard
    currentRange.PasteSpecial
        
    noErrorFound = 1
    
ErrHandler:
    If noErrorFound = 0 Then
        Application.ScreenUpdating = True
      '  MsgBox ("Stock " + Symbol + "DONE")
    End If
    Resume Next
    
      Range("C1:I1").Select
    Selection.ColumnWidth = 8
    
'turn calculation back on

    Application.DisplayAlerts = True
    Range("C8:I600").Select
    Selection.Sort Key1:=Range("C8"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
        
    RemoveNames
    'UpdateScale
Range("A1").Select

    
    
End Sub
'Sub Sort_Based_on_a_Single_Column()

'Worksheets("Calculations").Range("A5:Q600").Sort Key1:=Range("H8"), Order1:=xlAscending

'End Sub

Sub RemoveNames()

Dim nQuery As Name

        For Each nQuery In Names
            If IsNumeric(Right(nQuery.Name, 1)) Then
                nQuery.Delete
            End If
        Next nQuery

End Sub
Sub Clear()
'
' Clear Macro
' Macro recorded 8/13/2006 by Ponzo

    Sheets("Calculations").Select  ' move to Calculations sheet
     Worksheets("Calculations").Range("A1:F600").ClearContents      ' CLEAR OLD STUFF

     Worksheets("Download").Range("C8:I600").ClearContents      ' CLEAR OLD STUFF

    
    Formats
    Sheets("Download").Select      ' move back
    
End Sub
Sub Move()
'
' Move Macro
' Macro recorded 09/03/2007 by pjPonzo
'

    Range("C7:C600").Select
    Selection.Copy
    Range("K7").Select
    ActiveSheet.Paste
    
    Range("I7:I600").Select
    Selection.Copy
    Range("L7").Select
    ActiveSheet.Paste

End Sub

Sub Init()
'
' Init Macro
' Macro recorded 09/03/2007 by pjPonzo
'

'
    Range("K3:P10").Select
    Selection.Copy
    Sheets("Calculations").Select
    Range("A1:P2000").Select
    ActiveSheet.Paste
    Sheets("Download").Select
End Sub

Sub DownloadData()
     Application.ScreenUpdating = False
     Dim freqFlag As String
     Dim numRows As Integer
     Dim noErrorFoundInDownloadData As Integer
     noErrorFoundInDownloadData = 0
    
     On Error GoTo ErrHandlerDownloadData:
    
     freqFlag = "1d"
     If Worksheets("Download").Range("$B$5") = 1 Then
        freqFlag = "1d"
        'plus 2 due to the intitial two rows
        numRows = DateDiff("d", Worksheets("Download").Range("$B$2"), Worksheets("Download").Range("$B$3")) + 2
     ElseIf Worksheets("Download").Range("$B$5") = 2 Then
        freqFlag = "1wk"
        numRows = DateDiff("w", Worksheets("Download").Range("$B$2"), Worksheets("Download").Range("$B$3")) + 2
     ElseIf Worksheets("Download").Range("$B$5") = 3 Then
        freqFlag = "1mo"
        numRows = DateDiff("m", Worksheets("Download").Range("$B$2"), Worksheets("Download").Range("$B$3")) + 2
     End If
     
     
     Worksheets("Download").Select
    ' Worksheets("Download").UsedRange.Clear
 
     'Stock 1
     If Worksheets("Download").Range("$C$13") <> "NONE" Then

     Call GetOne(Worksheets("Download").Range("$B$4"), Worksheets("Download").Range("$B$2"), Worksheets("Download").Range("$B$3"), "$A$1", freqFlag)
     
     End If
     
     Range("C7").Select
            
     Columns("C:J").EntireColumn.AutoFit
          
     
     Dim vvx As Integer
     vvx = Application.Version
            
     If (vvx >= 12) Then
      'Excel 2007
      ActiveWorkbook.Worksheets("Download").Sort.SortFields.Clear
      ActiveWorkbook.Worksheets("Download").Sort.SortFields.Add Key:=Range("C8:C6550") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
      With ActiveWorkbook.Worksheets("Download").Sort
         .SetRange Range("C7:J65500")
         .Header = xlYes
         .MatchCase = False
         .Orientation = xlTopToBottom
         .SortMethod = xlPinYin
         .Apply
      End With
     Else
      'Exel 2003
      Columns("C:J").Select
      Selection.Sort Key1:=Range("C8"), Order1:=xlAscending, Header:=xlGuess, _
         OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
         DataOption1:=xlSortNormal
     End If
     
     'End If
     Worksheets("Download").Select
     Worksheets("Download").Range("J8").Select
     
    noErrorFoundInDownloadData = 1
    Application.ScreenUpdating = True
ErrHandlerDownloadData:
  
End Sub
Sub Formats()
'
' Formats Macro
' Macro recorded 9/5/2008 by pjPonzo
'

'
    Range("A1:P1").Select
    Selection.Copy
    Range("A10:P6000").Select
    Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        
    Range("A1").Select
    Selection.ClearContents
    
End Sub

All Stock_testing.xlsm
ABCDEFGHIJKLMNOP
13stocks249
2 Start Date 9-Aug-21248
3 End Date 9-Aug-222479-Aug-22
4ScriptINFY.NS246SYMBOLDATEOPENHIGHLOWCLOSE
5245INFY.NS1-Aug-221564.001564.001537.901551.05
6INFY.NS2-Aug-221546.551547.001528.351543.60
7StocksDateOpenHighLowCloseAdj CloseVolumeINFY.NS3-Aug-221549.001570.001539.901566.10
8^NSEI9-Aug-211661.001667.451646.401663.301,631.415018477INFY.NS4-Aug-221587.501603.851574.951599.90
9^NSEBANK10-Aug-211668.001680.001661.051677.251,645.096846517INFY.NS5-Aug-221608.401625.701602.301616.65
10INFY.NS11-Aug-211674.801684.001668.001677.551,645.394899639INFY.NS
1112-Aug-211679.151696.501674.001689.601,657.215659579
1213-Aug-211697.001722.501691.301712.201,679.375612790
1316-Aug-211707.701719.951690.101704.401,671.724564109
1417-Aug-211703.901748.901686.551741.651,708.269510390
1518-Aug-211729.001755.501727.001733.451,700.226686090
1620-Aug-211716.101745.001716.101732.951,699.736206972
1723-Aug-211735.751753.151732.001738.751,705.416189051
1824-Aug-211750.001757.001712.701720.851,687.867602939
1925-Aug-211718.001746.901718.001735.551,702.286153253
2026-Aug-211734.001746.001720.001727.701,694.585302248
Download
Cell Formulas
RangeFormula
C1C1=COUNTA(A8:A600)
B2B2=B3-365
B3,K3B3=TODAY()
I1I1=COUNTA($G$8:$G$600)
I2I2=COUNTA($I$8:$I$600)-1
I3I3=COUNTA($I$8:$I$600)-2
I4I4=COUNTA($I$8:$I$600)-3
I5I5=COUNTA($I$8:$I$600)-4
L5L5=INDEX($C$8:$C$600,I5)
M5M5=INDEX($D$8:$D$600,I5)
N5N5=INDEX($E$8:$E$600,I5)
O5O5=INDEX($F$8:$F$600,I5)
P5P5=INDEX($G$8:$G$600,I5)
L6L6=INDEX($C$8:$C$600,I4)
M6M6=INDEX($D$8:$D$600,I4)
N6N6=INDEX($E$8:$E$600,I4)
O6O6=INDEX($F$8:$F$600,I4)
P6P6=INDEX($G$8:$G$600,I4)
L7L7=INDEX($C$8:$C$600,I3)
M7M7=INDEX($D$8:$D$600,I3)
N7N7=INDEX($E$8:$E$600,I3)
O7O7=INDEX($F$8:$F$600,I3)
P7P7=INDEX($G$8:$G$600,I3)
L8L8=INDEX($C$8:$C$600,I2)
M8M8=INDEX($D$8:$D$600,I2)
N8N8=INDEX($E$8:$E$600,I2)
O8O8=INDEX($F$8:$F$600,I2)
P8P8=INDEX($G$8:$G$600,I2)
L9L9=INDEX($C$8:$C$600,I1)
M9M9=INDEX($D$8:$D$600,I1)
N9N9=INDEX($E$8:$E$600,I1)
O9O9=INDEX($F$8:$F$600,I1)
P9P9=INDEX($G$8:$G$600,I1)
K5:K10K5=$B$4
Cells with Data Validation
CellAllowCriteria
B4List=SYMBOL!$A$2:$A$1917
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Sort by date Sort by votes
vishu said:
Hello everyone,
Let me try to explain you all
I have a "Download" sheet Column "A" has Stocklist when am clicking the "Download All" button it extracts all stock data and the Last 5 days' data shows to K5:P10 and that data copy and paste to the "Calculation" sheet Column "A:F" which also getting paste.

But here my problem start

The "Download" Sheet doing its job perfectly but the "calculation" sheet does not paste correctly, only the last stock pastes fully 5 days of data and the rest only pastes 1 day of data. This is incorrect 5 days of data for each stock need to be pasted into the "calculation" sheet.

Thanks in advance

below providing VBA code for your reference. please help me to solve this problem.

VBA Code: 
'Copyright 2008-2018 ConnectCode Pte Ltd. All Rights Reserved.
'This source code is protected by International Copyright Laws.
Dim gError As Integer

Sub GetData()
'   thanks to Ron McEwan :^)

    Dim QuerySheet As Worksheet
    Dim DataSheet As Worksheet
    Dim SYMBOL As String
    Dim i As Integer, N As Integer, pct As Double
   

    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationAutomatic
   
    Set DataSheet = ActiveSheet

    N = Range("C1")

    Clear                           ' clear old data
    Init                            ' paste headings
' ----------------------------------


For i = 1 To N
   
    Range("A1") = i
    Range("B4") = Cells(i + 7, 1)  ' get symbol
    Cells(i + 7, 1).Select
   
      Call GetOne(Worksheets("Download").Range("$B$4"), Worksheets("Download").Range("$B$2"), Worksheets("Download").Range("$B$3"), "$A$1", freqFlag)
                          ' download one stock
   
   Application.ScreenUpdating = False
  
    Range("K5:P10").Select           ' collect calculations
    Selection.Copy
      
    Sheets("Calculations").Select      ' move to Calculations sheet
    Cells(i + 2, 1).Select      ' select proper row and paste calculations
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Sheets("Download").Select           ' move to Data sheet
   
    Application.ScreenUpdating = True
   
Next i

    Range("A1").Select
    Selection.ClearContents

    Sheets("Calculations").Select
    Formats
    Range("C1").Select

End Sub

Sub GetOne(ByVal SYMBOL As String, ByVal startDate As Date, ByVal endDate As Date, ByVal desti As String, ByVal freq As String)
   
    On Error GoTo ErrHandler:
   
    Dim crumb               As String
    Dim cookie               As String
    Dim response               As String
    Dim strUrl As String
    Dim DownloadURL As String
    Dim period1, period2 As String
    Dim httpReq As WinHttp.WinHttpRequest
    Dim nQuery As Name

    Set httpReq = New WinHttp.WinHttpRequest
   
    DownloadURL = "https://finance.yahoo.com/lookup?s=" & SYMBOL
    With httpReq
        .Open "GET", DownloadURL, False
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
        .send
        .waitForResponse
        response = .ResponseText
        cookie = Split(.getResponseHeader("Set-Cookie"), ";")(0)
    End With

    period1 = (startDate - DateValue("January 1, 1970")) * 86400
    period2 = (endDate - DateValue("January 1, 1970")) * 86400
   
    Dim counter As Long
    Dim startCounter As Long
    Dim result As String
    Dim dataResult As String
    Dim startResult As String
       
    crumb = Chr(34) & "CrumbStore" & Chr(34) & ":{" & Chr(34) & "crumb" & Chr(34) & ":" & Chr(34)
    startCounter = InStr(response, crumb) + Len(crumb)
    While Mid(response, startCounter, 1) <> Chr(34)
        result = result & Mid(response, startCounter, 1)
        startCounter = startCounter + 1
    Wend
   
    crumb = result
    DownloadURL = "https://query1.finance.yahoo.com/v7/finance/download/" & SYMBOL & "?period1=" & period1 & "&period2=" & period2 & "&interval=" + freq + "&events=history&crumb=" & crumb
   
    startResult = ""
    startCounter = 0
    While (startResult <> "Date" And startCounter < 8)
        With httpReq
            .Open "GET", DownloadURL, False
            .setRequestHeader "Cookie", cookie
            .send
            .waitForResponse
            dataResult = .ResponseText
        End With
        startResult = Mid(dataResult, 1, 4)
        startCounter = startCounter + 1
    Wend
   
    If (startResult <> "Date") Then
        noErrorFound = 0
        GoTo ErrHandler
    End If
   
    dataResult = Replace(dataResult, ",", vbTab)

    Dim dataObj As New DataObject
    dataObj.SetText dataResult
    dataObj.PutInClipboard
           
    Set currentWorksheet = ThisWorkbook.ActiveSheet
    Set currentRange = currentWorksheet.Range("C7")
    dataObj.GetFromClipboard
    currentRange.PasteSpecial
       
    noErrorFound = 1
   
ErrHandler:
    If noErrorFound = 0 Then
        Application.ScreenUpdating = True
      '  MsgBox ("Stock " + Symbol + "DONE")
    End If
    Resume Next
   
      Range("C1:I1").Select
    Selection.ColumnWidth = 8
   
'turn calculation back on

    Application.DisplayAlerts = True
    Range("C8:I600").Select
    Selection.Sort Key1:=Range("C8"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
       
    RemoveNames
    'UpdateScale
Range("A1").Select

   
   
End Sub
'Sub Sort_Based_on_a_Single_Column()

'Worksheets("Calculations").Range("A5:Q600").Sort Key1:=Range("H8"), Order1:=xlAscending

'End Sub

Sub RemoveNames()

Dim nQuery As Name

        For Each nQuery In Names
            If IsNumeric(Right(nQuery.Name, 1)) Then
                nQuery.Delete
            End If
        Next nQuery

End Sub
Sub Clear()
'
' Clear Macro
' Macro recorded 8/13/2006 by Ponzo

    Sheets("Calculations").Select  ' move to Calculations sheet
     Worksheets("Calculations").Range("A1:F600").ClearContents      ' CLEAR OLD STUFF

     Worksheets("Download").Range("C8:I600").ClearContents      ' CLEAR OLD STUFF

   
    Formats
    Sheets("Download").Select      ' move back
   
End Sub
Sub Move()
'
' Move Macro
' Macro recorded 09/03/2007 by pjPonzo
'

    Range("C7:C600").Select
    Selection.Copy
    Range("K7").Select
    ActiveSheet.Paste
   
    Range("I7:I600").Select
    Selection.Copy
    Range("L7").Select
    ActiveSheet.Paste

End Sub

Sub Init()
'
' Init Macro
' Macro recorded 09/03/2007 by pjPonzo
'

'
    Range("K3:P10").Select
    Selection.Copy
    Sheets("Calculations").Select
    Range("A1:P2000").Select
    ActiveSheet.Paste
    Sheets("Download").Select
End Sub

Sub DownloadData()
     Application.ScreenUpdating = False
     Dim freqFlag As String
     Dim numRows As Integer
     Dim noErrorFoundInDownloadData As Integer
     noErrorFoundInDownloadData = 0
   
     On Error GoTo ErrHandlerDownloadData:
   
     freqFlag = "1d"
     If Worksheets("Download").Range("$B$5") = 1 Then
        freqFlag = "1d"
        'plus 2 due to the intitial two rows
        numRows = DateDiff("d", Worksheets("Download").Range("$B$2"), Worksheets("Download").Range("$B$3")) + 2
     ElseIf Worksheets("Download").Range("$B$5") = 2 Then
        freqFlag = "1wk"
        numRows = DateDiff("w", Worksheets("Download").Range("$B$2"), Worksheets("Download").Range("$B$3")) + 2
     ElseIf Worksheets("Download").Range("$B$5") = 3 Then
        freqFlag = "1mo"
        numRows = DateDiff("m", Worksheets("Download").Range("$B$2"), Worksheets("Download").Range("$B$3")) + 2
     End If
    
    
     Worksheets("Download").Select
    ' Worksheets("Download").UsedRange.Clear
 
     'Stock 1
     If Worksheets("Download").Range("$C$13") <> "NONE" Then

     Call GetOne(Worksheets("Download").Range("$B$4"), Worksheets("Download").Range("$B$2"), Worksheets("Download").Range("$B$3"), "$A$1", freqFlag)
    
     End If
    
     Range("C7").Select
           
     Columns("C:J").EntireColumn.AutoFit
         
    
     Dim vvx As Integer
     vvx = Application.Version
           
     If (vvx >= 12) Then
      'Excel 2007
      ActiveWorkbook.Worksheets("Download").Sort.SortFields.Clear
      ActiveWorkbook.Worksheets("Download").Sort.SortFields.Add Key:=Range("C8:C6550") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
      With ActiveWorkbook.Worksheets("Download").Sort
         .SetRange Range("C7:J65500")
         .Header = xlYes
         .MatchCase = False
         .Orientation = xlTopToBottom
         .SortMethod = xlPinYin
         .Apply
      End With
     Else
      'Exel 2003
      Columns("C:J").Select
      Selection.Sort Key1:=Range("C8"), Order1:=xlAscending, Header:=xlGuess, _
         OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
         DataOption1:=xlSortNormal
     End If
    
     'End If
     Worksheets("Download").Select
     Worksheets("Download").Range("J8").Select
    
    noErrorFoundInDownloadData = 1
    Application.ScreenUpdating = True
ErrHandlerDownloadData:
 
End Sub
Sub Formats()
'
' Formats Macro
' Macro recorded 9/5/2008 by pjPonzo
'

'
    Range("A1:P1").Select
    Selection.Copy
    Range("A10:P6000").Select
    Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
       
    Range("A1").Select
    Selection.ClearContents
   
End Sub

All Stock_testing.xlsm
ABCDEFGHIJKLMNOP
13stocks249
2 Start Date 9-Aug-21248
3 End Date 9-Aug-222479-Aug-22
4ScriptINFY.NS246SYMBOLDATEOPENHIGHLOWCLOSE
5245INFY.NS1-Aug-221564.001564.001537.901551.05
6INFY.NS2-Aug-221546.551547.001528.351543.60
7StocksDateOpenHighLowCloseAdj CloseVolumeINFY.NS3-Aug-221549.001570.001539.901566.10
8^NSEI9-Aug-211661.001667.451646.401663.301,631.415018477INFY.NS4-Aug-221587.501603.851574.951599.90
9^NSEBANK10-Aug-211668.001680.001661.051677.251,645.096846517INFY.NS5-Aug-221608.401625.701602.301616.65
10INFY.NS11-Aug-211674.801684.001668.001677.551,645.394899639INFY.NS
1112-Aug-211679.151696.501674.001689.601,657.215659579
1213-Aug-211697.001722.501691.301712.201,679.375612790
1316-Aug-211707.701719.951690.101704.401,671.724564109
1417-Aug-211703.901748.901686.551741.651,708.269510390
1518-Aug-211729.001755.501727.001733.451,700.226686090
1620-Aug-211716.101745.001716.101732.951,699.736206972
1723-Aug-211735.751753.151732.001738.751,705.416189051
1824-Aug-211750.001757.001712.701720.851,687.867602939
1925-Aug-211718.001746.901718.001735.551,702.286153253
2026-Aug-211734.001746.001720.001727.701,694.585302248
Download
Cell Formulas
RangeFormula
C1C1=COUNTA(A8:A600)
B2B2=B3-365
B3,K3B3=TODAY()
I1I1=COUNTA($G$8:$G$600)
I2I2=COUNTA($I$8:$I$600)-1
I3I3=COUNTA($I$8:$I$600)-2
I4I4=COUNTA($I$8:$I$600)-3
I5I5=COUNTA($I$8:$I$600)-4
L5L5=INDEX($C$8:$C$600,I5)
M5M5=INDEX($D$8:$D$600,I5)
N5N5=INDEX($E$8:$E$600,I5)
O5O5=INDEX($F$8:$F$600,I5)
P5P5=INDEX($G$8:$G$600,I5)
L6L6=INDEX($C$8:$C$600,I4)
M6M6=INDEX($D$8:$D$600,I4)
N6N6=INDEX($E$8:$E$600,I4)
O6O6=INDEX($F$8:$F$600,I4)
P6P6=INDEX($G$8:$G$600,I4)
L7L7=INDEX($C$8:$C$600,I3)
M7M7=INDEX($D$8:$D$600,I3)
N7N7=INDEX($E$8:$E$600,I3)
O7O7=INDEX($F$8:$F$600,I3)
P7P7=INDEX($G$8:$G$600,I3)
L8L8=INDEX($C$8:$C$600,I2)
M8M8=INDEX($D$8:$D$600,I2)
N8N8=INDEX($E$8:$E$600,I2)
O8O8=INDEX($F$8:$F$600,I2)
P8P8=INDEX($G$8:$G$600,I2)
L9L9=INDEX($C$8:$C$600,I1)
M9M9=INDEX($D$8:$D$600,I1)
N9N9=INDEX($E$8:$E$600,I1)
O9O9=INDEX($F$8:$F$600,I1)
P9P9=INDEX($G$8:$G$600,I1)
K5:K10K5=$B$4
Cells with Data Validation
CellAllowCriteria
B4List=SYMBOL!$A$2:$A$1917
Click to expand...
Hello friends, Please help
 
Upvote 0
Trying to copy from the Download sheet >>> each script (A8:A) data from K5:P10 and Paste this data to the calculation sheet

suppose I have 3 scripts in the (A8:A) column then click the download button data copy from (Download to Calculation) But
1st & 2nd script >> Only single line i.e. (K5:P5)
3rd script perfectly pasting all data i.e. (K5:P10)

I am missing something here, that's why not getting the expected result. :(
VBA Code: 
For i = 1 To N
    
    Range("A1") = i
    Range("B4") = Cells(i + 7, 1)  ' get symbol
    Cells(i + 7, 1).Select
    Call GetOne(Worksheets("Download").Range("$B$4"), Worksheets("Download").Range("$B$2"), Worksheets("Download").Range("$B$3"), "$A$1", freqFlag)
    Application.ScreenUpdating = False
   
    Range("K5:P10").Select           ' collect calculations
    Selection.Copy
       
    Sheets("Calculations").Select      ' move to Calculations sheet
    Cells(i + 2, 1).Select      ' select proper row and paste calculations
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
    Sheets("Download").Select           ' move to Data sheet
    Application.ScreenUpdating = True
    
Next i

    Range("A1").Select
    Selection.ClearContents

DataSheet.Columns("A:F").AutoFit

    Sheets("Calculations").Select
    Formats
    Range("C1").Select
 

Attachments

  • Calculation.jpg
    Calculation.jpg
    133.1 KB · Views: 13
  • download.jpg
    download.jpg
    205.1 KB · Views: 13
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
Excel VBA for Yahoo Finance
Replies
5
Views
788
alansidman
alansidman
S
  • Solved
QueryTables bug. If one query fails, all subsequent queries will fail unless restart Excel
Replies
4
Views
453
Micron
M
L
  • Solved
Insert formulas to new lines in table
Replies
3
Views
162
Ltuk85
L
M
  • Solved
VBA Chart Series title with multiple cells
Replies
4
Views
141
mikejvir
M
A
  • Solved
Extract and Merge Files
Replies
1
Views
135
rowebca
rowebca

Forum statistics

Threads
1,224,812
Messages
6,181,104
Members
453,021
Latest member
Justyna P

Share this page

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