Link to home
Start Free TrialLog in
Avatar of vijay vj
vijay vjFlag for India

asked on

NEED TO UPDATE DATA IN EXCEL

DEAR SIR,

I have taken code here which is very help full for my work and i need one change in this excel,

The changes need is in excel "NSE-INDEX-IMPORTER-V01.XLSM" ,  data  to be imported in my main workbook after i have download csv file in folder and need to auto update data similar like in a"SAMPLE.XLSM", where stocks are separately placed in different worksheets and updated daily.


And thanks for your great work here...
NSE-Index-Importer-V01.xlsm
Sample.xlsm
Avatar of Shums Faruk
Shums Faruk
Flag of India image

Basically you want to copy Sample workbook VBA code to NSE-Index-Importer. Am I right?
Please attach two or three csv data as well.
Avatar of vijay vj

ASKER

Dear sir,

MR.Shums Thanks for your kind reply,  
"Basically you want to copy Sample workbook VBA code to NSE-Index-Importer. Am I right?",
you were correct , in sample xls its about equities of stocks related and in NSE index xls , its relates about index, so i need to index data to updated same as like Sample xls , specifically separate index to be updated in separate worksheet as it was hidden in sample xls.

sir........ thanks for your effort sir,
Please upload csv data for 2-3 trading days.
If you want to make just a copy of Sample workbook, then just save as Sample workbook as NSE-Index Importer
Dear sir i have attached last five days data in this excel.
NSE-Index-Importer-V01.xlsm
And csv files?
In your sample workbook, csv files are updated in csvData worksheet, then formula in Dashboard has linked/shared external workbook. How you want us to write VBA code, without necessary info and files. Even in your topic, its just Ms Excel, but your process can only be done in VBA. Topic must have both Ms Excel & VBA.
Sir, i dont need external link update , i need vba to auto update the download files only, dashboard worksheet leave it sir, i need only other worksheets to updated auto from downloaded files
OK I have different approach.

I will create a button, which will ask you to select csv files to be loaded in CSVdata sheet, once upload is finish, then in Dashboard sheet you can put your formula. Once your formula is updated, then you can upload csv on daily basis and your dashboard will be updated as per your formula.

Instead of making so many worksheets as per index name, I will create one new sheet, where you click on any Index to see its historical movement.

Will this be sufficient?
ok sir
ASKER CERTIFIED SOLUTION
Avatar of Shums Faruk
Shums Faruk
Flag of India image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Thanks for your great help sir
Is this the way you wanted?
yes sir i will work it out for few days and give you feed back sir.... now backtesting with old data sir....
Thanks for your great help sir
You're welcome and I'm glad I was able to help.
Dashboard vba


Private Sub UploadCsv_Click()
Dim FolderPath As String
Dim wizBook As Workbook
Dim Filter As String
Dim Caption As String
Dim wizFilename As String
Dim wizWorkbook As Workbook
Dim TargetWorkbook As Workbook
Dim LastRow1 As Long, LastRow2 As Long, LastRow3 As Long
Dim Ws As Worksheet

With Application
    .ScreenUpdating = False
    .DisplayStatusBar = True
    .StatusBar = "!!! Please Be Patient...Updating Records !!!"
    .EnableEvents = False
    .Calculation = xlManual
End With
Call ClearDashBoard
FolderPath = Application.ThisWorkbook.Path
ChDir FolderPath

' make weak assumption that active workbook is the target
Set TargetWorkbook = Application.ThisWorkbook
     
' get the wiz workbook
Filter = "Text files (*.cs*),*.cs*"
Caption = "Please Select an input file "

wizFilename = Application.GetOpenFilename(Filter, , Caption)
    
Set wizWorkbook = Application.Workbooks.Open(wizFilename)
    
' copy data to target workbook
Dim targetSheet As Worksheet

Set targetSheet = TargetWorkbook.Worksheets("CSVdata")
LastRow1 = targetSheet.Range("A" & Rows.Count).End(xlUp).Row
        
' copy data from wiz workbook
Dim sourceSheet As Worksheet
Set sourceSheet = wizWorkbook.Sheets(1)
sourceSheet.Activate
LastRow2 = sourceSheet.Range("A" & Rows.Count).End(xlUp).Row
        
sourceSheet.Range("A2:M" & LastRow2).Copy
targetSheet.Range("B" & LastRow1 + 1).PasteSpecial xlPasteValues
    
' Close wiz workbook
Application.DisplayAlerts = False
wizWorkbook.Close savechanges:=False
Application.DisplayAlerts = True
    
LastRow3 = targetSheet.Range("B" & Rows.Count).End(xlUp).Row
targetSheet.Range("A2").Formula = "1"
targetSheet.Range("A3:A" & LastRow3).FormulaR1C1 = "=IF(RC[1]="""","""",(R[-1]C+1))"
targetSheet.Range("A3:A" & LastRow3).Value = targetSheet.Range("A3:A" & LastRow3).Value
targetSheet.Columns.AutoFit
Application.GoTo reference:=targetSheet.Range("A" & LastRow3 - 10), Scroll:=True
Call MakeUniqueList
Call SortData
Call AddFormula
With Application
    .ScreenUpdating = True
    .DisplayStatusBar = True
    .StatusBar = False
    .EnableEvents = True
    .Calculation = xlAutomatic
End With

Set Ws = TargetWorkbook.Worksheets("DashBoard")
Ws.Activate
Ws.Columns.AutoFit
Ws.Range("A2").Select
End Sub
Sub ClearDashBoard()
Dim Ws As Worksheet
Dim LR As Long
Set Ws = Worksheets("DashBoard")
LR = Ws.Range("A" & Rows.Count).End(xlUp).Row
Ws.Range("A3:M" & LR).ClearContents
End Sub
Sub MakeUniqueList()
    Dim Ws1 As Worksheet, Ws2 As Worksheet
    Dim LR As Long
    Dim vaData As Variant
    Dim colUnique As Collection
    Dim aOutput() As Variant
    Dim i As Long
    
    Set Ws1 = Worksheets("CSVdata")
    Set Ws2 = Worksheets("DashBoard")
    LR = Ws1.Range("A" & Rows.Count).End(xlUp).Row
    
    'Put the data in an array
    vaData = Ws1.Range("B2:B" & LR).Value

    'Create a new collection
    Set colUnique = New Collection

    'Loop through the data
    For i = LBound(vaData, 1) To UBound(vaData, 1)
        'Collections can't have duplicate keys, so try to
        'add each item to the collection ignoring errors.
        'Only unique items will be added
        On Error Resume Next
            colUnique.Add vaData(i, 1), CStr(vaData(i, 1))
        On Error GoTo 0
    Next i

    'size an array to write out to the sheet
    ReDim aOutput(1 To colUnique.Count, 1 To 1)

    'Loop through the collection and fill the output array
    For i = 1 To colUnique.Count
        aOutput(i, 1) = colUnique.Item(i)
    Next i

    'Write the unique values to column A
    Ws2.Range("A3").Resize(UBound(aOutput, 1), UBound(aOutput, 2)).Value = aOutput

End Sub
Sub SortData()
Dim Ws As Worksheet
Dim LR As Long
Set Ws = Worksheets("DashBoard")
LR = Ws.Range("A" & Rows.Count).End(xlUp).Row

Ws.Sort.SortFields.Clear
    Ws.Sort.SortFields.Add Key:=Range("A3:A" & LR), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
    With Ws.Sort
        .SetRange Range("A2:M" & LR)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub
Sub AddFormula()
Dim Ws As Worksheet
Dim LR As Long
Dim Cell As Range
Set Ws = Worksheets("DashBoard")
LR = Ws.Range("A" & Rows.Count).End(xlUp).Row

Ws.Range("B3:B" & LR).FormulaR1C1 = "=INDEX(CSVdata!R2C[1]:R10000C[1],SUMPRODUCT(MAX(ROW(CSVdata!R2C2:R10000C2)*(RC1=CSVdata!R2C2:R10000C2))-1))"
Ws.Range("C3:C" & LR).FormulaR1C1 = "=INDEX(CSVdata!R2C[1]:R10000C[1],SUMPRODUCT(MAX(ROW(CSVdata!R2C2:R10000C2)*(RC1=CSVdata!R2C2:R10000C2))-1))"
Ws.Range("D3:D" & LR).FormulaR1C1 = "=INDEX(CSVdata!R2C[1]:R10000C[1],SUMPRODUCT(MAX(ROW(CSVdata!R2C2:R10000C2)*(RC1=CSVdata!R2C2:R10000C2))-1))"
Ws.Range("E3:E" & LR).FormulaR1C1 = "=INDEX(CSVdata!R2C[1]:R10000C[1],SUMPRODUCT(MAX(ROW(CSVdata!R2C2:R10000C2)*(RC1=CSVdata!R2C2:R10000C2))-1))"
Ws.Range("F3:F" & LR).FormulaR1C1 = "=INDEX(CSVdata!R2C[1]:R10000C[1],SUMPRODUCT(MAX(ROW(CSVdata!R2C2:R10000C2)*(RC1=CSVdata!R2C2:R10000C2))-1))"
Ws.Range("G3:G" & LR).FormulaR1C1 = "=INDEX(CSVdata!R2C[1]:R10000C[1],SUMPRODUCT(MAX(ROW(CSVdata!R2C2:R10000C2)*(RC1=CSVdata!R2C2:R10000C2))-1))"
Ws.Range("H3:H" & LR).FormulaR1C1 = "=INDEX(CSVdata!R2C[1]:R10000C[1],SUMPRODUCT(MAX(ROW(CSVdata!R2C2:R10000C2)*(RC1=CSVdata!R2C2:R10000C2))-1))"
Ws.Range("I3:I" & LR).FormulaR1C1 = "=INDEX(CSVdata!R2C[1]:R10000C[1],SUMPRODUCT(MAX(ROW(CSVdata!R2C2:R10000C2)*(RC1=CSVdata!R2C2:R10000C2))-1))"
Ws.Range("J3:J" & LR).FormulaR1C1 = "=INDEX(CSVdata!R2C[1]:R10000C[1],SUMPRODUCT(MAX(ROW(CSVdata!R2C2:R10000C2)*(RC1=CSVdata!R2C2:R10000C2))-1))"
Ws.Range("K3:K" & LR).FormulaR1C1 = "=INDEX(CSVdata!R2C[1]:R10000C[1],SUMPRODUCT(MAX(ROW(CSVdata!R2C2:R10000C2)*(RC1=CSVdata!R2C2:R10000C2))-1))"
Ws.Range("L3:L" & LR).FormulaR1C1 = "=INDEX(CSVdata!R2C[1]:R10000C[1],SUMPRODUCT(MAX(ROW(CSVdata!R2C2:R10000C2)*(RC1=CSVdata!R2C2:R10000C2))-1))"
Ws.Range("M3:M" & LR).FormulaR1C1 = "=INDEX(CSVdata!R2C[1]:R10000C[1],SUMPRODUCT(MAX(ROW(CSVdata!R2C2:R10000C2)*(RC1=CSVdata!R2C2:R10000C2))-1))"

End Sub

Open in new window

Autoupdate vba
Option Explicit

Private Sub Refresh_Click()
Dim SrcSheet As Worksheet, TrgSheet As Worksheet
Dim LR_Src As Long, LR_Trg As Long
With Application
    .ScreenUpdating = False
    .DisplayStatusBar = True
    .StatusBar = "!!! Please Be Patient...Updating Records !!!"
    .EnableEvents = False
    .Calculation = xlManual
End With
Set SrcSheet = Worksheets("CSVdata")
Set TrgSheet = Worksheets("HistoricalData")
LR_Src = SrcSheet.Range("A" & Rows.Count).End(xlUp).Row
LR_Trg = SrcSheet.Range("A" & Rows.Count).End(xlUp).Row
TrgSheet.Range("A3:N" & LR_Trg).ClearContents
SrcSheet.Activate
SrcSheet.Range("A2:N" & LR_Src).Copy
TrgSheet.Activate
TrgSheet.Range("A3").PasteSpecial xlPasteValues
TrgSheet.Range("A2").Select
With Application
    .ScreenUpdating = True
    .DisplayStatusBar = True
    .StatusBar = False
    .EnableEvents = True
    .Calculation = xlAutomatic
End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim strCriteria As String, LastRow As Long
    
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    strCriteria = Range("B1").Value
    
    If Not Intersect(Target, Range("B1")) Is Nothing Then
        With Me
            If .AutoFilterMode = True Then .AutoFilterMode = False
            If .Range("B1").Value = vbNullString Then
                .AutoFilterMode = False
                Exit Sub
            End If
            .Range("B2:B" & LastRow).AutoFilter Field:=1, Criteria1:="=" & strCriteria
        End With
    End If

End Sub

Open in new window