Formatting BSEeq

Hi Experts,

I have one file which download data from web and format that data. need to add few more step in existing Module "aStartEquityBSE" after all process done.

Step 1 In  .csv file - cell P1 past this text "<TICKER>,<NAME>,<DATE>,<OPEN>,<HIGH>,<LOW>,<CLOSE>,<VOL>"
Step 2 in cell P2 past this formula till end "=A2&","&B2&","&TEXT(D2,"YYYYMMDD")&","&E2&","&F2&","&G2&","&H2&","&L2"
Step 3 Copy column P and past to new open .txt file and save as .csv file name
Step 4 Delete original .csv file
Step 5 Next .csv
END

In attached I am talking about A9 Cell Button.

Thanks
Incoporated-Download-File-V19---Copy.xls
EQ020315.xlsx
LVL 8
Naresh PatelTraderAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Naresh PatelTraderAuthor Commented:
Assuming above all steps add in existing routine and not like done previous routine and run above steps via new routine.

Thanks
0
gowflowCommented:
ok will do shortly.
gowflow
0
gowflowCommented:
First comment I see you did not post the last version of the main file did you disreguard it ? like no need for Del/Keep ?? on what version shall I work ?
gowflow
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

Naresh PatelTraderAuthor Commented:
Extremely sorry ....by mistake attached wrong file...have to implement in latest version I.e. version 20.

Thanks
0
gowflowCommented:
ok no problem just checking.
gowflow
0
gowflowCommented:
in P1
"<TICKER>,<NAME>,<DATE>,<OPEN>,<HIGH>,<LOW>,<CLOSE>,<VOL>"

can it be
"TICKER,NAME,DATE,OPEN,HIGH,LOW,CLOSE,VOL"

as previous CreateTXT was like this no < >.
Also we save as csv or txt ?
we delete original csv ?

gowlfow
0
Naresh PatelTraderAuthor Commented:
in P1
 "<TICKER>,<NAME>,<DATE>,<OPEN>,<HIGH>,<LOW>,<CLOSE>,<VOL>"

 can it be
 "TICKER,NAME,DATE,OPEN,HIGH,LOW,CLOSE,VOL"

 as previous CreateTXT was like this no < >.

Yes this is right "<TICKER>,<NAME>,<DATE>,<OPEN>,<HIGH>,<LOW>,<CLOSE>,<VOL>"
as I have 2 Technical software - AmiBroker & MetaStock 10.1 both are licensed. but in AmiBroker I have liberty to ignore header but in MetaStock have to go like this "<>" to read this .txt file. In Previous have to change to "<>".

Also we save as csv or txt ?
 
Save as .txt
we delete original csv ?
Delete original .csv

Thanks
0
gowflowCommented:
ok here is your solution

1) Make a copy of your latest file and call it .... V21
2) Open VBA and open the module aStartEquityBSE and delete ALL THE CODE THAT IS THERE.
3) Paste the below new code in this module

Function FormatingEquityBSE(sType As String, sFolder As String) As String
On Error GoTo ErrHandler

Dim WB As Workbook
Dim WS As Worksheet
Dim WSAudit As Worksheet
Dim WSMain As Worksheet
Dim MaxRow As Long, MaxCol As Long, MaxRowA As Long, I As Long, J As Long
Dim lUns As Long, lRows As Long
Dim Rng As Range, cRow As Range
Dim sFile As String, sDirName As String, sDate As String, Res As String, sTextFile As String
Dim colFiles As New Collection
Dim vFile As Variant
    
'---> Set Variables
Set WSAudit = Sheets("Audit")
MaxRowA = WSAudit.Range("A" & WSAudit.Rows.Count).End(xlUp).Row
If MaxRowA = 1 Then MaxRowA = MaxRowA + 1
Set WSMain = ActiveSheet

'---> Get the Recursive Files and folders
RecursiveDir colFiles, sFolder, "*.csv", True

For Each vFile In colFiles
           
    '---> Get full name
    sFile = Dir(vFile)
    sDirName = Mid(vFile, 1, InStrRev(vFile, "\"))
    
    '---> Update Trace
    If Not bTrace Then
        WSMain.Cells(14, "A").EntireRow.Insert
        WSMain.Cells(14, "A") = sType
        WSMain.Cells(14, "B") = sDirName
        WSMain.Cells(14, "C") = sFile
    End If
    
    '---> Disable Events
    With Application
        .EnableEvents = False
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With
    
    '---> Open workbook and affect variables
    Set WB = Workbooks.Open(vFile)
    Set WS = WB.ActiveSheet
    MaxRow = WS.UsedRange.Rows.Count
    MaxCol = WS.UsedRange.Columns.Count
    
    
    sDate = Mid(WS.Name, 5, 2) & "/" & Mid(WS.Name, 3, 2) & "/" & Mid(WS.Name, 7, 2)
    WS.Range("D1") = "Date"
    WS.Range("D2:D" & MaxRow) = sDate
    
    
    
    '---> Create Text File depending on Origin requested.
    Select Case sType
        Case "Equity BSE"
            sTextFile = Mid(sFile, 1, Len(sFile) - 3) & "TXT"
            Res = CreateTXTEquity(WS, sDirName & sTextFile, MaxRow, sType)
        
    End Select
    
    If Res <> "" Then
        If Not bTrace Then
            WSMain.Cells(14, "A").EntireRow.Insert
            WSMain.Cells(14, "A") = sType
            WSMain.Cells(14, "B") = sDirName
            WSMain.Cells(14, "C") = sTextFile
            WSMain.Cells(14, "F") = "Created"
        End If
    Else
        If Not bTrace Then
            WSMain.Cells(14, "A").EntireRow.Insert
            WSMain.Cells(14, "A") = sType
            WSMain.Cells(14, "B") = sDirName
            WSMain.Cells(14, "C") = "No File Created"
            WSMain.Cells(14, "F") = "Error"
        End If
    End If
    
    '---> Register the record found in Audit
    If Not bAudit Then
        WSAudit.Cells(MaxRowA, "A") = Now
        WSAudit.Cells(MaxRowA, "B") = sFile
        WSAudit.Cells(MaxRowA, "C") = sDate
        MaxRowA = MaxRowA + 1
    End If
    DoEvents
    
    '---> Save workbook
    WB.Close savechanges:=True
    
    '---> If TXT successful then delete CSV
    If Res <> "" Then
        Kill (sDirName & sFile)
        
        If Not bTrace Then
            WSMain.Cells(14, "A").EntireRow.Insert
            WSMain.Cells(14, "A") = sType
            WSMain.Cells(14, "B") = sDirName
            WSMain.Cells(14, "C") = sFile
            WSMain.Cells(14, "F") = "Deleted"
        End If
    End If
    
    '---> reset Variables
    Set WS = Nothing
    Set WB = Nothing
    Set Rng = Nothing
    lUns = 0
    lRows = 0
    'MaxRowM = MaxRowM + 1

        
    '---> Enable Events
    With Application
        .EnableEvents = True
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    
Next vFile

'---> fix Layout
If Not bAudit Then
    WSAudit.UsedRange.EntireColumn.AutoFit
End If

'---> Set Flag to complete successful and exit
FormatingEquityBSE = ""
Exit Function

ErrHandler:
MsgBox (Error(Err))
FormatingEquityBSE = Error(Err)
Resume
On Error GoTo 0

End Function



''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DownloadFileEquityBSE
' This downloads a file from a URL to a local filename.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function DownloadFileEquityBSE(Overwrite As DownloadFileDisposition) As Boolean
    Dim WSMain As Worksheet
   
    Dim DestinationFileName As String
    Dim Disp As DownloadFileDisposition
    Dim Res As VbMsgBoxResult
    Dim ErrorText As String
    Dim B As Boolean
    Dim S As String
    Dim L As Long
    Dim MaxRowM As Long
    
    'Dim strStartDate As String
    'Dim strEndDate As String
    Dim datLastDate As Date
    Dim datWorkDate As Date
    Dim iYear As Integer
    Dim strMonth As String
    Dim strDay As String
    Dim strFileName As String
    Dim strFilePath As String
    Dim strSavePath As String
    Dim sLastDownloadeddate As String
    Dim oFso As Object

    
    Set WSMain = ActiveSheet

    '---> Clean Previous Trace
    If Not bDoit Then
        WSMain.Range("A14:I" & WSMain.Rows.Count).ClearContents
    End If
    MaxRowM = 14
    
    
    ErrorText = vbNullString

    strSavePath = gstDestinationFolder
    
    If Not bTrace Then
        WSMain.Cells(14, "A").EntireRow.Insert
        WSMain.Cells(14, "A") = "Equity BSE"
        WSMain.Cells(14, "B") = strSavePath
        WSMain.Cells(14, "C") = "*.*"
        WSMain.Cells(14, "F") = "Deleting"
        'MaxRowM = MaxRowM + 1
    End If
    
    '---> Delete All files in Directory prior to proceeding
    DeleteFiles strSavePath
    
    Set oFso = CreateObject("Scripting.FileSystemObject")

    With oFso
        If Not .FolderExists(strSavePath) Then
            MakeMultiStepDirectory strSavePath
        End If
    End With

    
    If dEndDate = vbEmpty Or dStartDate = vbEmpty Then
        MsgBox "Missing either Strat Date or End Date procedure will exit.", vbCritical
        Exit Function
    End If
    
    datLastDate = DateValue(dEndDate)      'DateSerial(iYear, 4, 9)
    datWorkDate = DateValue(dStartDate)    'DateSerial(iYear, 1, 1)
    
    
    Do
        ' EG http://www.bseindia.com/download/BhavCopy/Equity/EQ291214_CSV.ZIP
        strFileName = "EQ" & Format(datWorkDate, "ddmmyy") & "_CSV.ZIP"    ' e.g. EQ291214_CSV.ZIP
        strFilePath = sHTTP & strFileName
        
        If Right(strSavePath, 1) <> "\" Then strSavePath = strSavePath & "\"

        DestinationFileName = strSavePath & strFileName

        If Dir(DestinationFileName, vbNormal) <> vbNullString Then
            Select Case Overwrite
                Case OverwriteKill
                    On Error Resume Next
                    Err.Clear
                    Kill DestinationFileName
                    If Err.Number <> 0 Then
                        ErrorText = "Error Killing file '" & DestinationFileName & "'." & vbCrLf & Err.Description
                        DownloadFileEquityBSE = False
                    End If

                Case OverwriteRecycle
                    On Error Resume Next
                    Err.Clear
                    B = RecycleFileOrFolder(DestinationFileName)
                    If B = False Then
                        ErrorText = "Error Recycleing file '" & DestinationFileName & "." & vbCrLf & Err.Description
                        DownloadFileEquityBSE = False
                        Exit Function
                    End If

                Case DoNotOverwrite
                    DownloadFileEquityBSE = False
                    ErrorText = "File '" & DestinationFileName & "' exists and disposition is set to DoNotOverwrite."
                    Exit Function

                    'Case PromptUser
                Case Else
                    S = "The destination file '" & DestinationFileName & "' already exists." & vbCrLf & _
                        "Do you want to overwrite the existing file?"
                    Res = MsgBox(S, vbYesNo, "Download File")
                    If Res = vbNo Then
                        ErrorText = "User selected not to overwrite existing file."
                        DownloadFileEquityBSE = False
                        Exit Function
                    End If
                    B = RecycleFileOrFolder(DestinationFileName)
                    If B = False Then
                        ErrorText = "Error Recycling file '" & DestinationFileName & "." & vbCrLf & Err.Description
                        DownloadFileEquityBSE = False
                        Exit Function
                    End If
            End Select
        End If
        Debug.Print strFilePath & " validity: " & GetURLStatus(strFilePath)
        If GetURLStatus(strFilePath) = "200 - OK" Then
            L = DeleteUrlCacheEntry(strFilePath)
            L = URLDownloadToFile(0&, strFilePath, DestinationFileName, 0&, 0&)
            Select Case L
                Case Is = 0
                    DownloadFileEquityBSE = True
                    sLastDownloadeddate = datWorkDate
                    
                    '---> Update Trace
                    If Not bTrace Then
                        WSMain.Cells(14, "A").EntireRow.Insert
                        WSMain.Cells(14, "A") = "Equity BSE"
                        WSMain.Cells(14, "B") = strSavePath
                        WSMain.Cells(14, "C") = strFileName
                        WSMain.Cells(14, "F") = "Created"
                        'MaxRowM = MaxRowM + 1
                    End If
                Case Is = -2146697210
                    ErrorText = "File not found."
                    DownloadFileEquityBSE = False
                Case Is = -2146697211
                    ErrorText = "Domain not found."
                    DownloadFileEquityBSE = False
                Case Is = -2147467260
                    ErrorText = "Transfer aborted."
                    DownloadFileEquityBSE = False
                Case Else
                    ErrorText = "Buffer length invalid or not enough memory."
                    DownloadFileEquityBSE = False
            End Select
        End If
        datWorkDate = DateAdd("d", 1, datWorkDate)
    Loop Until datWorkDate > datLastDate

'---> Set New Start Date = last successful date + Clear End Date
If sLastDownloadeddate <> "" Then
    Range("E9").Value = DateAdd("d", 1, sLastDownloadeddate)
    Range("F9").Formula = "=Today()"
    'MsgBox "Last Successful downloaded file was on " & sLastDownloadeddate & Chr(10) & "The next set date for next run of the routine will be set at " & Range("G3").Value
Else
    Range("F9").Formula = "=Today()"
    'MsgBox "No Files where found in this Interval try later."
End If

End Function

Function CreateTXTEquity(WS As Worksheet, sWBName As String, MaxRow As Long, sType As String) As String
On Error GoTo ErrCreateTXT
Dim Rng As Range
Dim rRow As Range

'---> Title In P1
'"<TICKER>,<NAME>,<DATE>,<OPEN>,<HIGH>,<LOW>,<CLOSE>,<VOL>"
WS.Range("P1") = "<TICKER>,<NAME>,<DATE>,<OPEN>,<HIGH>,<LOW>,<CLOSE>,<VOL>"

'---> Formula in P2 and down
'P2 "=A2&","&B2&","&TEXT(D2,"YYYYMMDD")&","&E2&","&F2&","&G2&","&H2&","&L2"
WS.Range("P2:P" & MaxRow).Formula = "=A2&"",""&B2&"",""&TEXT(D2,""YYYYMMDD"")&"",""&E2&"",""&F2&"",""&G2&"",""&H2&"",""&L2"
'WS.Range("P2:P" & MaxRow).Formula = "=IF(OR(A2=""FUTSTK"",A2=""FUTIDX""),C2&"" ""&B2&"",""&TEXT(O2,""DD-MMM-YY"")&"",""&F2&"",""&G2&"",""&H2&"",""&I2&"",""&K2&"",""&M2,IF(OR(A2=""OPTIDX"",A2=""OPTSTK""),C2&"" ""&B2&"" ""&D2&"" ""&E2&"",""&TEXT(O2,""DD-MMM-YY"")&"",""&F2&"",""&G2&"",""&H2&"",""&I2&"",""&K2&"",""&M2,""""))"

Select Case sType
        Case "Equity BSE"
            '---> Sort as per Col P Ascending
            WS.Range("A1:P" & MaxRow).Sort key1:=WS.Range("P1"), order1:=xlAscending, Header:=xlYes, MatchCase:=no
            
            
End Select

'---> Copy Col P to A and set Rng the new Range
WS.Range("P2:P" & MaxRow).Copy
WS.Range("P2").PasteSpecial xlPasteValues

WS.Range("A:O").EntireColumn.Delete
Set Rng = WS.Range("A1:A" & MaxRow)

'---> Crete the TXT File
Open sWBName For Output As #1
For Each rRow In Rng
    Print #1, rRow.Value
Next rRow

Close #1

'WS.SaveAs Filename:=sWBName, FileFormat:=xlCSV

CreateTXTEquity = sWBName

Set WS = Nothing
Set Rng = Nothing

Exit Function

ErrCreateTXT:
CreateTXTEquity = ""
Err = 0
Resume
End Function

Open in new window


4) SAVE and Exit the workbook.
5) Open it and give it a try.

gowflow
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Naresh PatelTraderAuthor Commented:
Perfect
0
Naresh PatelTraderAuthor Commented:
May I ask next question?
0
gowflowCommented:
Shoot
0
Naresh PatelTraderAuthor Commented:
Here It Is.

Thanks
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.