Formatting NSEeq

Hi Experts,

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

 Step 1 In  .csv file - cell P1 past this text "<TICKER>,<DATE>,<OPEN>,<HIGH>,<LOW>,<CLOSE>,<VOL>"
Step 2 in cell P2 past this formula till end "=A2&","&TEXT(K2,"YYYYMMDD")&","&C2&","&D2&","&E2&","&F2&","&I2"
 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 A4 Cell Button.

 Thanks
Incoporated-Download-File-V20.xlsm
cm04MAR2015bhav.xlsx
LVL 8
Naresh PatelTraderAsked:
Who is Participating?
 
gowflowCommented:
ok I reduced the flicquering as much as possible but it is a complicated routine so we need to re-update like before.

1) Make a new copy and call it V23
2) Goto VBA and do the following

 3) In module mdlDeleteRows DELETE ALL the code that is there and replace it by the following code:

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

Dim WB As Workbook
Dim WS As Worksheet
Dim WSDelRows As Worksheet
Dim WSAudit As Worksheet
Dim WSMain As Worksheet
Dim MaxRow As Long, MaxCol As Long, MaxRowA As Long, MaxRowE As Long, MaxRowM As Long, I As Long
Dim lUns As Long, lRows As Long
Dim Rng As Range, cRow As Range
Dim sFile As String, sDirName As String, sTextFile As String, Res As String
Dim colFiles As New Collection
Dim vFile As Variant
    
'---> Set Variables
Set WSDelRows = Sheets("Delete Rows")
MaxRowE = WSDelRows.Range("A" & WSDelRows.Rows.Count).End(xlUp).Row
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

'---> Clean Previous Trace
'WSMain.Range("A14:I" & WSMain.Rows.Count).ClearContents
MaxRowM = WSMain.Range("B" & WSMain.Rows.Count).End(xlUp).Row + 1


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") = "Equity"
        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
    
    '---> If Delivery then delete first 3 rows of CSV prior start
    If sType = "Del" Then
        WS.Range("1:3").EntireRow.Delete
    End If
    
    
    '---> Loop Thru all the Criteria
    For I = 2 To MaxRowE Step 2
        If WS.AutoFilterMode = True Then WS.ShowAllData
        
        '---> Check Criteria depending on Type
        If sType = "Equ" Then
            WS.Range("H3").AutoFilter Field:=WSDelRows.Cells(I, "B"), Criteria1:=WSDelRows.Cells(I, "A"), Operator:=xlAnd, Criteria2:=WSDelRows.Cells(I + 1, "A")
        Else
            WS.Range("H3").AutoFilter Field:=WSDelRows.Cells(I, "C"), Criteria1:=WSDelRows.Cells(I, "A"), Operator:=xlAnd, Criteria2:=WSDelRows.Cells(I + 1, "A")
        End If
        
        '---> Set the Current Range
        On Error Resume Next
        Set Rng = WS.Range(WS.Range("A2"), WS.Cells(MaxRow, MaxCol)).EntireRow.SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        
        '---> Count the number of Rows
        lRows = 0
        If Not Rng Is Nothing Then
            For Each cRow In Rng.EntireRow
                lRows = lRows + 1
            Next cRow
        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") = lRows
        
        
            If Not Rng Is Nothing Then
                WSAudit.Cells(MaxRowA, "D") = Rng.Address
            Else
                WSAudit.Cells(MaxRowA, "D") = "No Rows found for deletion"
            End If
        End If
        
        MaxRowA = MaxRowA + 1
        lUns = lUns + 1
        
        If Not bTrace Then
            '---> Disable Trace
            With Application
                 .ScreenUpdating = False
            End With
        
            WSMain.Activate
        
            '---> enable Trace
            With Application
                 .ScreenUpdating = True
            End With
        End If
    
        '---> Update Trace Deleted row count
        If Not bTrace Then
            WSMain.Cells(14, "E") = lRows
        End If
        
        '---> Disable Trace
        With Application
             .ScreenUpdating = False
        End With
        
        '---> Delete all Rows
        If Not Rng Is Nothing Then
            Rng.Delete
        End If
        
        If WS.AutoFilterMode = True Then
            WS.ShowAllData
        End If
        WS.AutoFilterMode = False
        WS.UsedRange.EntireColumn.AutoFit
        MaxRow = WS.UsedRange.Rows.Count
        
        '---> enable Trace
        With Application
             .ScreenUpdating = True
        End With
            
        '---> Update Trace rec count
        If Not bTrace Then
            WSMain.Cells(14, "D") = I
        End If
        DoEvents
        
        '---> Disable Trace
        With Application
             .ScreenUpdating = False
        End With
    Next I
    
    
    '---> enable Trace
    With Application
         .ScreenUpdating = True
    End With
        
    '---> Update Trace Status
    If Not bTrace Then
        WSMain.Cells(14, "F") = "Done"
    End If
    
    '---> Disable Trace
    With Application
         .ScreenUpdating = False
    End With
        
    '---> Create Text File depending on Origin requested.
    Select Case sType
        Case "Equ"
            sTextFile = Mid(sFile, 1, Len(sFile) - 3) & "TXT"
            Res = CreateTXTEquity(WS, sDirName & sTextFile, MaxRow, sType)
        
    End Select
    
    '---> enable Trace
    With Application
         .ScreenUpdating = True
    End With
    
    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
    
    '---> Disable Trace
    With Application
         .ScreenUpdating = False
    End With
    
    '---> Save workbook
    WB.Close savechanges:=True
    
    '---> enable Trace
    With Application
         .ScreenUpdating = True
    End With
    
    '---> 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
    
    '---> Disable Trace
    With Application
         .ScreenUpdating = False
    End With
    
    '---> reset Variables
    Set WS = Nothing
    Set WB = Nothing
    Set Rng = Nothing
    lUns = 0
    lRows = 0
    'MaxRowM = MaxRowM + 1
    
    
Next vFile

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

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

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

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

End Function

Public Function RecursiveDir(colFiles As Collection, _
                              strFolder As String, _
                              strFileSpec As String, _
                              bIncludeSubfolders As Boolean)

Dim strTemp As String
Dim colFolders As New Collection
Dim vFolderName As Variant

'---> Add files in strFolder matching strFileSpec to colFiles
strFolder = TrailingSlash(strFolder)
strTemp = Dir(strFolder & strFileSpec)
Do While strTemp <> vbNullString
    colFiles.Add strFolder & strTemp
    strTemp = Dir
Loop

If bIncludeSubfolders Then
    '---> Fill colFolders with list of subdirectories of strFolder
    strTemp = Dir(strFolder, vbDirectory)
    Do While strTemp <> vbNullString
        If (strTemp <> ".") And (strTemp <> "..") Then
            If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0 Then
                colFolders.Add strTemp
            End If
        End If
        strTemp = Dir
    Loop

    '---> Call RecursiveDir for each subfolder in colFolders
    For Each vFolderName In colFolders
        Call RecursiveDir(colFiles, strFolder & vFolderName, strFileSpec, True)
    Next vFolderName
End If

End Function


Public Function TrailingSlash(strFolder As String) As String
If Len(strFolder) > 0 Then
    If Right(strFolder, 1) = "\" Then
        TrailingSlash = strFolder
    Else
        TrailingSlash = strFolder & "\"
    End If
End If
End Function

Open in new window



4) SAVE the workbook.
 5) In module astartEquityBSE DELETE ALL the code that is there and replace it by the below code:

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

'---> Disable Trace
With Application
     .ScreenUpdating = False
End With

Select Case sType
        Case "Equity BSE"
            '---> 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"

            '---> Sort as per Col P Ascending
            WS.Range("A1:P" & MaxRow).Sort key1:=WS.Range("P1"), order1:=xlAscending, Header:=xlYes, MatchCase:=no
           
          Case "Equ"
            '---> Titel in P1
            '"<TICKER>,<DATE>,<OPEN>,<HIGH>,<LOW>,<CLOSE>,<VOL>"
            WS.Range("P1") = "<TICKER>,<DATE>,<OPEN>,<HIGH>,<LOW>,<CLOSE>,<VOL>"

            
            '---> Formula in P2 and down
            'P2 "=A2&","&TEXT(K2,"YYYYMMDD")&","&C2&","&D2&","&E2&","&F2&","&I2"
            WS.Range("P2:P" & MaxRow).Formula = "=A2&"",""&TEXT(K2,""YYYYMMDD"")&"",""&C2&"",""&D2&"",""&E2&"",""&F2&"",""&I2"

            '---> 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

'---> Enable Trace
With Application
     .ScreenUpdating = True
End With


Exit Function

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

Open in new window


6) SAVE and Exit the workbook.
 7) Open it and try it.

 gowflow
0
 
gowflowCommented:
Will attend once done with present stuff.
gowflow
0
 
Naresh PatelTraderAuthor Commented:
Ok Sir.

Thanks
0
Cloud Class® Course: Ruby Fundamentals

This course will introduce you to Ruby, as well as teach you about classes, methods, variables, data structures, loops, enumerable methods, and finishing touches.

 
Naresh PatelTraderAuthor Commented:
?
0
 
gowflowCommented:
Yes but this one is bit more tricky as it was first developed I need to see how to incorporate. Will revert
gowflow
0
 
Naresh PatelTraderAuthor Commented:
Ok Sir,

Thanks
0
 
gowflowCommented:
Before posting the solution is it normal that these files created endup with 2 records only ??? and the header makes it 3 ??? as we are going thru the delete rows ???

pls confirm
gowlfow
0
 
Naresh PatelTraderAuthor Commented:
Nope - Only 2 records not normal.More then 2 recordSee attached file.

Thanks
cm04MAR2015bhav.xlsx
0
 
gowflowCommented:
ok let me troubleshoot this as run it and have 4 files with only 2 records.
gowflow
0
 
gowflowCommented:
ok found it. One more question we sort descendant or ascendant ?
gowflow
0
 
Naresh PatelTraderAuthor Commented:
A to A

Thanks
0
 
Naresh PatelTraderAuthor Commented:
A to Z
0
 
gowflowCommented:
as when I sort Ascendant I get a bunch of rows with
,19000100,,,,,
,19000100,,,,,
,19000100,,,,,
,19000100,,,,,
,19000100,,,,,
,19000100,,,,,
,19000100,,,,,
,19000100,,,,,
,19000100,,,,,
,19000100,,,,,
,19000100,,,,,
,19000100,,,,,
,19000100,,,,,
,19000100,,,,,
,19000100,,,,,
,19000100,,,,,
,19000100,,,,,

then the real data is it normal ??
gowflow
0
 
gowflowCommented:
Forget my comment !!!!

I told you it was a tough one. Just found it.
gowlfow
0
 
Naresh PatelTraderAuthor Commented:
I know you said it is tough one.
0
 
gowflowCommented:
ok here is your solution:

1) Make a copy of your latest file and call it V22
2) Goto VBA and do the following

3) In module mdlDeleteRows DELETE ALL the code that is there and replace it by the following code:

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

Dim WB As Workbook
Dim WS As Worksheet
Dim WSDelRows As Worksheet
Dim WSAudit As Worksheet
Dim WSMain As Worksheet
Dim MaxRow As Long, MaxCol As Long, MaxRowA As Long, MaxRowE As Long, MaxRowM As Long, I As Long
Dim lUns As Long, lRows As Long
Dim Rng As Range, cRow As Range
Dim sFile As String, sDirName As String, sTextFile As String, Res As String
Dim colFiles As New Collection
Dim vFile As Variant
    
'---> Set Variables
Set WSDelRows = Sheets("Delete Rows")
MaxRowE = WSDelRows.Range("A" & WSDelRows.Rows.Count).End(xlUp).Row
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

'---> Clean Previous Trace
'WSMain.Range("A14:I" & WSMain.Rows.Count).ClearContents
MaxRowM = WSMain.Range("B" & WSMain.Rows.Count).End(xlUp).Row + 1


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") = "Equity"
        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
    
    '---> If Delivery then delete first 3 rows of CSV prior start
    If sType = "Del" Then
        WS.Range("1:3").EntireRow.Delete
    End If
    
    If Not bTrace Then
        WSMain.Activate
        
        '---> enable Trace
        With Application
             .ScreenUpdating = True
        End With
    End If
    
    '---> Loop Thru all the Criteria
    For I = 2 To MaxRowE Step 2
        If WS.AutoFilterMode = True Then WS.ShowAllData
        
        '---> Check Criteria depending on Type
        If sType = "Equ" Then
            WS.Range("H3").AutoFilter Field:=WSDelRows.Cells(I, "B"), Criteria1:=WSDelRows.Cells(I, "A"), Operator:=xlAnd, Criteria2:=WSDelRows.Cells(I + 1, "A")
        Else
            WS.Range("H3").AutoFilter Field:=WSDelRows.Cells(I, "C"), Criteria1:=WSDelRows.Cells(I, "A"), Operator:=xlAnd, Criteria2:=WSDelRows.Cells(I + 1, "A")
        End If
        
        '---> Set the Current Range
        On Error Resume Next
        Set Rng = WS.Range(WS.Range("A2"), WS.Cells(MaxRow, MaxCol)).EntireRow.SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        
        '---> Count the number of Rows
        lRows = 0
        If Not Rng Is Nothing Then
            For Each cRow In Rng.EntireRow
                lRows = lRows + 1
            Next cRow
        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") = lRows
        
        
            If Not Rng Is Nothing Then
                WSAudit.Cells(MaxRowA, "D") = Rng.Address
            Else
                WSAudit.Cells(MaxRowA, "D") = "No Rows found for deletion"
            End If
        End If
        
        MaxRowA = MaxRowA + 1
        lUns = lUns + 1
        
        '---> Update Trace Deleted row count
        If Not bTrace Then
            WSMain.Cells(14, "E") = lRows
        End If
        
        '---> Delete all Rows
        If Not Rng Is Nothing Then
            Rng.Delete
        End If
        
        If WS.AutoFilterMode = True Then
            WS.ShowAllData
        End If
        WS.AutoFilterMode = False
        WS.UsedRange.EntireColumn.AutoFit
        MaxRow = WS.UsedRange.Rows.Count
        
        '---> Update Trace rec count
        If Not bTrace Then
            WSMain.Cells(14, "D") = I
        End If
        DoEvents
    Next I
    
    
    '---> Update Trace Status
    If Not bTrace Then
        WSMain.Cells(14, "F") = "Done"
    End If
    
    
    '---> Create Text File depending on Origin requested.
    Select Case sType
        Case "Equ"
            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
DelSpecRowCSV = ""
Exit Function

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

End Function

Public Function RecursiveDir(colFiles As Collection, _
                              strFolder As String, _
                              strFileSpec As String, _
                              bIncludeSubfolders As Boolean)

Dim strTemp As String
Dim colFolders As New Collection
Dim vFolderName As Variant

'---> Add files in strFolder matching strFileSpec to colFiles
strFolder = TrailingSlash(strFolder)
strTemp = Dir(strFolder & strFileSpec)
Do While strTemp <> vbNullString
    colFiles.Add strFolder & strTemp
    strTemp = Dir
Loop

If bIncludeSubfolders Then
    '---> Fill colFolders with list of subdirectories of strFolder
    strTemp = Dir(strFolder, vbDirectory)
    Do While strTemp <> vbNullString
        If (strTemp <> ".") And (strTemp <> "..") Then
            If (GetAttr(strFolder & strTemp) And vbDirectory) <> 0 Then
                colFolders.Add strTemp
            End If
        End If
        strTemp = Dir
    Loop

    '---> Call RecursiveDir for each subfolder in colFolders
    For Each vFolderName In colFolders
        Call RecursiveDir(colFiles, strFolder & vFolderName, strFileSpec, True)
    Next vFolderName
End If

End Function


Public Function TrailingSlash(strFolder As String) As String
If Len(strFolder) > 0 Then
    If Right(strFolder, 1) = "\" Then
        TrailingSlash = strFolder
    Else
        TrailingSlash = strFolder & "\"
    End If
End If
End Function

Open in new window


4) SAVE the workbook.
5) In module astartEquityBSE DELETE ALL the code that is there and replace it by the below code:

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



Select Case sType
        Case "Equity BSE"
            '---> 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"

            '---> Sort as per Col P Ascending
            WS.Range("A1:P" & MaxRow).Sort key1:=WS.Range("P1"), order1:=xlAscending, Header:=xlYes, MatchCase:=no
           
          Case "Equ"
            '---> Titel in P1
            '"<TICKER>,<DATE>,<OPEN>,<HIGH>,<LOW>,<CLOSE>,<VOL>"
            WS.Range("P1") = "<TICKER>,<DATE>,<OPEN>,<HIGH>,<LOW>,<CLOSE>,<VOL>"

            
            '---> Formula in P2 and down
            'P2 "=A2&","&TEXT(K2,"YYYYMMDD")&","&C2&","&D2&","&E2&","&F2&","&I2"
            WS.Range("P2:P" & MaxRow).Formula = "=A2&"",""&TEXT(K2,""YYYYMMDD"")&"",""&C2&"",""&D2&"",""&E2&"",""&F2&"",""&I2"

            '---> 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



6) SAVE and Exit the workbook.
7) Open it and try it.

gowflow
0
 
Naresh PatelTraderAuthor Commented:
5) In module astartEquityBSE DELETE ALL the code that is there and replace it by the below code:
Are you sure about to delete astartEquityBSE or astartEquity.?

As we are doing this for NSEeq & BSEeq is done in previous question.

Thanks
0
 
gowflowCommented:
astartEquityBSE

as we are using the same sub that we created before. To avoid doubles.


and don't be worried !!!
gowflow
0
 
Naresh PatelTraderAuthor Commented:
Working Perfect - Only need to screen updating = False.

Thanks
0
 
Naresh PatelTraderAuthor Commented:
May I ask next question?
0
 
Naresh PatelTraderAuthor Commented:
I mean preparing mean while ?
0
 
Naresh PatelTraderAuthor Commented:
Do you want me close this question ?
0
 
Naresh PatelTraderAuthor Commented:
Awesome
0
 
Naresh PatelTraderAuthor Commented:
May I next question of Index?

Thanks
0
 
gowflowCommented:
Yes pls go ahead.
gowflow
0
 
Naresh PatelTraderAuthor Commented:
Here It Is.

Thanks
0
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.

All Courses

From novice to tech pro — start learning today.