Code Modification

Hi Experts,

I have one file which downloads data from web and format in particular manner. just need to change some thing in one process.

this is regarding button "Index" Cell A5. in final out put it convert .csv file in to .txt format but need to change date format in that as currently date shown as "YYYYDDMM" format need to be in "YYYYMMDD" format.

See attached file (PassWord "gowflow")

Thanks
Incoporated-Download-File-Final-V24.xlsm
LVL 8
Naresh PatelFinancial AdviserAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
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.

Saurabh Singh TeotiaCommented:
The format i found in your code was ddmmyyyy and here is the updated import index code for your reference..replace only these lines in that and this will do what you are looking for..

Current lines...

If HttpExists(sHTTP & Format(xx, "ddmmyyyy") & ".csv") Then
        txtFileName = Format(xx, "ddmmyyyy")
        lastDate = xx
        
        Set WkBk = Workbooks.Add
    
        With ActiveSheet.QueryTables.Add(Connection:="URL;" & sHTTP & Format(xx, "ddmmyyyy") & ".csv", Destination:=Range("$A$1"))

Open in new window


Revised....

If HttpExists(sHTTP & Format(xx, "yyyymmdd") & ".csv") Then
        txtFileName = Format(xx, "yyyymmdd")
        lastDate = xx
        
        Set WkBk = Workbooks.Add
    
        With ActiveSheet.QueryTables.Add(Connection:="URL;" & sHTTP & Format(xx, "yyyymmdd") & ".csv", Destination:=Range("$A$1"))

Open in new window

Naresh PatelFinancial AdviserAuthor Commented:
Sorry For Delay - Nope Not Working - Just Deleted Data From My Index Folder.

Thank You
Saurabh Singh TeotiaCommented:
I checked your entire code and you don't have that format which is YYYYDDMM anywhere in any of your macro codes..Can you help me refer where you see that format?

Also if i check the index code.. In that format you have is ddmmyyyy...However if i notice correctly in cell c14 you are getting files which are ddmmmyyyy and i'm guessing that's the format you are looking for since your file name is in that format..
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

Naresh PatelFinancial AdviserAuthor Commented:
Mr.Saurabh,

Even I don't know how's code going as it is created by one of EE Expert "Sir.Gowflow".and I don't have too much knowledge of VBA coding.

Thanks
Saurabh Singh TeotiaCommented:
Okay then are you able to make changes which i told you earlier? In additional can you confirm what's the file name which you see as in which format ..that you want to write?
Naresh PatelFinancial AdviserAuthor Commented:
Yes I did changed but it doesn't work .
Saurabh Singh TeotiaCommented:
Also..Can you confirm the file name as in in which format you are getting the files..so what's the name for it?
gowflowCommented:
Currently the date when txt is made up shows as:
YYYYMMDD

So don't understand your request.
gowflow
gowflowCommented:
I just saw the problem. For some reason, the csv file that you are downloading is now showing the date as 6/4/2015 where in fact it is 6 April 2015 and as the formula converts it to YYYYMMDD you are getting 20150604 which is June 4 and not April 6.

The request is just the opposite of what you asked for and the formula need to be changed from YYYYMMDD to YYYYDDMM so it reads correctly.

Here is how to implement in your production workbook.

1) Make a copy of your latest file and give it a new name V25
2) Open it and goto VBA and doubleclick on the module aStartEquityBSE
3) Click on the bottom left icon to display 1 sub at a time.
4) From the right top dropdown select the Sub CreateTXTEquity and delete the whole Sub from
Sub CreateTXTEquity ...
...
End Sub
5) Paste the below code after any End Sub in this module.

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
        
        Case "Index"
            '---> 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(B2,"YYYYMMDD")&","&C2&","&D2&","&E2&","&F2&","&I2"
            WS.Range("P2:P" & MaxRow).Formula = "=A2&"",""&TEXT(B2,""YYYYDDMM"")&"",""&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 give it a try.

gowflow

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 PatelFinancial AdviserAuthor Commented:
Extremely Sorry For Delay.

I Had Tried Your Solution But There Is Error Message.VBA Error
Thank you
Naresh PatelFinancial AdviserAuthor Commented:
Little change and it is working.
Naresh PatelFinancial AdviserAuthor Commented:
Applied code but not worked but read your logic and changed "YYYYMMDD" to "YYYYDDMM" in existing code and it worked so accepted as solution.

Thnaks
Naresh PatelFinancial AdviserAuthor Commented:
:( Still Wont Worked......What To Do ? Raise New Question?
gowflowCommented:
no please let me know what is the problem. When I post a solution usually I test it and it is working here. Presume you did a bogus when you copied the code.

Are you sure you did step 3) in my list of things to do as if you did not then it is very easy to make mistakes when copying the code.

I suggest you forget what you did and simply redo the step I asked for in my last post taking a copy of your latest WORKING version and go slowly and do all the steps. the error you show Ambiguous name detected means that the sub exist in 2 copies more likely and this is your problem. You need to locate the old one where  I told you and delete it completely then paste the new code.

Let me know.
gowflow
gowflowCommented:
Did you try what I suggested in last post ?
gowflow
Naresh PatelFinancial AdviserAuthor Commented:
Sorry For Delay,

I had tried trice ...and here is the result.Screen 1Screen 2Thanks
Naresh PatelFinancial AdviserAuthor Commented:
instead will you please attached your version of WB?

Thanks
gowflowCommented:
Naresh PatelFinancial AdviserAuthor Commented:
Sir.Gowflow,

Still Some Thing wrong In Code - I had investigated - I had downloaded data for the duration 1-Jan-2014 to 31-Dec-2014.
Uploaded data in to my software it shows me weird chart.Errors in chart Mostly for date  I had seen gaps and so  I find that particular .txt file for those days but story Is some thing different. For 28-Nov-2014 i.e. 28112014.txt file have proper date format "YYYYMMDD" but seen some thing different in 02122014.txt. there is date format is like this "YYYYDDMM".

tried to search in code but it is above my capability. please help me out.

Thanks
Naresh PatelFinancial AdviserAuthor Commented:
Here is the .txt file screen short - Where problem occurs.Date Formatting ErrorI had tested if i run old download file which is only for index file and do manually - data upload properly. so there is no issue with downloaded file which have different date format . all file have same date format.

Thanks
Saurabh Singh TeotiaCommented:
itjockey..You understand Hindi?? And i know it's a stupid question looking at what you are tracking..yeh application khud neh banyi hai??
Naresh PatelFinancial AdviserAuthor Commented:
@Mr.Saurabh Singh Teotia,

I Understand.
Hindi (Natinal Language) -Gujarati (Mother Tounge) - English (Not Up To The Mark) - Marathi (Thoda Bahot).

What M I tracking
I am trader as well as Sub Broker so tracking Stock market.

Nope I dint  - Sir.Gowflow.
if mene banayi then why wud I ask question :)

Thank You
Saurabh Singh TeotiaCommented:
Hmm chalo gud to know...Pata lagh gaya tha application dekh kar...

next time mujhe jabh invest karna hoga..will seek your advice..pechali baar toh sabh nuksaan hoa gaya..now looking for a share to put money in short term for 1-3 months but abhi takh dimaag maine kuch samajh hai nahin aa raha..
Naresh PatelFinancial AdviserAuthor Commented:
KOKUYOCMLN 10x Duration 1Year ;)
gowflowCommented:
Sorry but this is not a forum for personal issues you can send freely messages and have this conversation.

Let me recap your problem
You downloaded thru the new version 2 files
28112014.txt
02122014.txt
and each one has a date format that is different ???

If the answer is YES then my question is:
ARE you SURE that you downloaded both files thru the new version ??? or the 28112014.txt
 is thru the old version and the 02122014.txt thru the new version ???

gowflow
Naresh PatelFinancial AdviserAuthor Commented:
"Sorry but this is not a forum for personal issues you can send freely messages and have this conversation.
"
Noted.

Yes both downloaded from the WB you attached in your last post.

Thank You
gowflowCommented:
what is the date range you have put so I put the same and test.
gowflow
Naresh PatelFinancial AdviserAuthor Commented:
1-Jan-2014 to 31-Dec-2014
gowflowCommented:
But this will take ages to build right ? how long ?
gowflow
Naresh PatelFinancial AdviserAuthor Commented:
15 min max.....if internet speed is above 2mbps  then 8 min.
Naresh PatelFinancial AdviserAuthor Commented:
Tim only index sub.
Naresh PatelFinancial AdviserAuthor Commented:
*run  sorry typo mistake
gowflowCommented:
So the problem you have is on date
02122014.txt

? is this feb 12 or Dec 2 ?
gowflow
Naresh PatelFinancial AdviserAuthor Commented:
Dec 2
gowflowCommented:
Well I just found the problem !

and here is it.
Basically the date that you have in the csv that is pulled in Col B is not a correct date
here is the explanation
For dates from 1 to 12 the dates are ok as they show as
1/12/2014

however starting date 13 (the system consider the first figure a month so it becomes
13-12-2014
and Excel changes the csv or it is originally on the web saved as 13-12-2014 and not 13/12/2014 and when the formatting comes it is not applied and the date stays as 13-12-2014

So the problem as I see it here lies in dates 13 to 31 not like you stated on small dates.

Now it depends on your window setting what do you have as dates in your window setting I have MM/DD/YYYY

gowflow
Naresh PatelFinancial AdviserAuthor Commented:
I have DD-MMM-YY
Naresh PatelFinancial AdviserAuthor Commented:
NSEeq have same king of formatting but I don't find problem in those .txt files.


Thanks
Naresh PatelFinancial AdviserAuthor Commented:
Too many typo mistake as reply from cell phone and it auto corrects.

Apology
gowflowCommented:
well becoz you have dd-mmm-yy then you are having a problem with the small numbers from 1 to 12 as opposed to me having problem with large ones from 13 to 31 as my system is mm/dd/yyyy

Will need to convert the date in csv to a correct date prior to creating the text file.

One last question if at the end the formatting is YYYYMMDD as originally it was and is for all other files will be fine for you ?

gowflow
Naresh PatelFinancial AdviserAuthor Commented:
Yes fine with YYYYMMDD.

Thanks
gowflowCommented:
ok then try this version
gowflow
Incoporated-Download-File-Final-V26.xlsm
gowflowCommented:
You did not tell me, is this new version fixed your problem ?
gowflow
Naresh PatelFinancial AdviserAuthor Commented:
Nope Sir it did not ....I had changed my system date also to over come but negative. I wondered why - if aStartEquiry worked fine with same .txt formatting why not worked with aStartIndex?

Thanks
gowflowCommented:
can you post the txt file you get with the last version I posted ? so I can look at it ?
Do you have a possibility to trap and also post the corepsonding csv as well like 2 files the csv and the txt file.
gowflow
Naresh PatelFinancial AdviserAuthor Commented:
Sir.Gowflow,

I had downloaded for April month - there is 19 Files available on server - After excusing code out of 19 - 6 are not properly dated. Downloaded Dates are "1, 6, 7, 8, 9, 10, 13, 15, 16,...." . Not properly formatted files are for the date " 1, 6, 7, 8, 9, 10.

attaching 2 pair of files (.txt as well as .csv)

Thank You
01042015.csv
01042015.txt
06042015.csv
06042015.txt
gowflowCommented:
Sorry for all this trouble that you had to go through but the issue was definitively not easy to dissect and clear.

Here is the solution that hopefully will work.

1) Make a copy of your latest file and give it a new name.
2) Open it and goto VBA and doublclick on module aStartEquityBSE and click on the bottom left icon to display 1 sub at a time.
3) Locate the sub CreateTXTequity and delete it.
4) Paste the below code after any END Sub.

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
Dim I As Long
Dim dTmp As String
Dim vTmp

'---> 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
        
        Case "Index"
            '---> Titel in P1
            '"<TICKER>,<DATE>,<OPEN>,<HIGH>,<LOW>,<CLOSE>,<VOL>"
            WS.Range("P1") = "<TICKER>,<DATE>,<OPEN>,<HIGH>,<LOW>,<CLOSE>,<VOL>"
            
            '---> Fix Date in B2 as it is DD/MM/YY it should be MM/DD/YY
            For I = 2 To MaxRow
                WS.Range("B" & I) = Replace(WS.Range("B" & I), "-", "/")
                vTmp = Split(WS.Range("B" & I), "/")
                dTmp = vTmp(1) & "/" & vTmp(0) & "/" & vTmp(2)
                WS.Range("B" & I) = dTmp
                vTmp = vbEmpty
                dTmp = vbEmpty
            Next I
                
            '---> Formula in P2 and down
            'If Val(Mid(WS.Range("B2"), 1, InStr(1, WS.Range("B2"), "/") - 1)) <= 12 Then
                'P2 =A2&","&TEXT(B2,"YYYYDDMM")&","&C2&","&D2&","&E2&","&F2&","&I2"
            '    WS.Range("P2:P" & MaxRow).Formula = "=A2&"",""&TEXT(B2,""YYYYDDMM"")&"",""&C2&"",""&D2&"",""&E2&"",""&F2&"",""&I2"
            'Else
                'P2 =A2&","&TEXT(B2,"YYYYMMDD")&","&C2&","&D2&","&E2&","&F2&","&I2"
                WS.Range("P2:P" & MaxRow).Formula = "=A2&"",""&TEXT(B2,""YYYYMMDD"")&"",""&C2&"",""&D2&"",""&E2&"",""&F2&"",""&I2"
            'End If
            
            '---> 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


5) SAVE and exit the workbook.
6) Open it and give it a try,

Let me know ASAP.
gowflow
Naresh PatelFinancial AdviserAuthor Commented:
Did what you suggested but only downloading ....after that just processing dint go ahead waited for 2 min but even 1 file dint processed so force closed .....after force closing I had run old file too which downloading files from server as well as process as .txt file.


Thanks
Naresh PatelFinancial AdviserAuthor Commented:
Keep On Processing - Dint Go Ahead
gowflowCommented:
It seems you have a problem adding new code.

Please open the workbook you have and goto VBA and doubleclik on the module aStartEquityBSE and paste in here ALL the code that is in this module. I will check it out to make sure it is fine.

BTW are you sure you did not comment out something from last trial as you posted csv and txt as the routine delete the csv when it create the txt file so maybe you commented out some instructions and this is why it is not working. ???
gowflow
Naresh PatelFinancial AdviserAuthor Commented:
here it is
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
Dim I As Long
Dim dTmp As String
Dim vTmp

'---> 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
        
        Case "Index"
            '---> Titel in P1
            '"<TICKER>,<DATE>,<OPEN>,<HIGH>,<LOW>,<CLOSE>,<VOL>"
            WS.Range("P1") = "<TICKER>,<DATE>,<OPEN>,<HIGH>,<LOW>,<CLOSE>,<VOL>"
            
            '---> Fix Date in B2 as it is DD/MM/YY it should be MM/DD/YY
            For I = 2 To MaxRow
                WS.Range("B" & I) = Replace(WS.Range("B" & I), "-", "/")
                vTmp = Split(WS.Range("B" & I), "/")
                dTmp = vTmp(1) & "/" & vTmp(0) & "/" & vTmp(2)
                WS.Range("B" & I) = dTmp
                vTmp = vbEmpty
                dTmp = vbEmpty
            Next I
                
            '---> Formula in P2 and down
            'If Val(Mid(WS.Range("B2"), 1, InStr(1, WS.Range("B2"), "/") - 1)) <= 12 Then
                'P2 =A2&","&TEXT(B2,"YYYYDDMM")&","&C2&","&D2&","&E2&","&F2&","&I2"
            '    WS.Range("P2:P" & MaxRow).Formula = "=A2&"",""&TEXT(B2,""YYYYDDMM"")&"",""&C2&"",""&D2&"",""&E2&"",""&F2&"",""&I2"
            'Else
                'P2 =A2&","&TEXT(B2,"YYYYMMDD")&","&C2&","&D2&","&E2&","&F2&","&I2"
                WS.Range("P2:P" & MaxRow).Formula = "=A2&"",""&TEXT(B2,""YYYYMMDD"")&"",""&C2&"",""&D2&"",""&E2&"",""&F2&"",""&I2"
            'End If
            
            '---> 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


Thanks
gowflowCommented:
It is working perfectly here. take the last 'working version' that you had (prior to the last change you did) first test it and make sure it works and does not block. then do the following:

1) open VBA and doubleclick on module aStartEquityBSE and select all and delelte all the code in that module.
2) Select all the code in your last thread that you posted ID 40757623 and paste that code in that module.
3) SAVE and exit
4) Open it and give it a try.

gowflow
Naresh PatelFinancial AdviserAuthor Commented:
Sir.Gowflow,

Did as you suggested
 1) Run the code on last working version...it had created .txt file

2) All your Steps from above post did it ....but result same ...it stuck after downloading.StucksThanks
gowflowCommented:
Well don't know what you did but here is the result I got from the same workbook and same code.
Check at least if the result is correct.
gowflow
Temp.zip
Naresh PatelFinancial AdviserAuthor Commented:
This is quite annoying ...what you think ..is my machine is not good i.e. processor not up to the mark?

yes seen all result. all is perfect.
gowflowCommented:
should not. it seems it is not going thru the createtxt routine. lets do the same thing but with an other module the aStartIndex

1) Open the workbook in which you had put all the code the last one when you put code in module aStatEquityBSE
2) goto VBA and doubleclick on module aStartIndex and delete all the code that is there
3) Paste the below code there in that module.

Sub ImportIndex()
Dim WSMain As Worksheet
Dim rgStart As Range
Dim WkBk As Excel.Workbook
Dim lastDate As Date
Dim txtFileName As String

Application.ScreenUpdating = True

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

If Not bTrace Then
    WSMain.Cells(14, "A").EntireRow.Insert
    WSMain.Cells(14, "A") = "Index"
    WSMain.Cells(14, "B") = gstDestinationFolder
    WSMain.Cells(14, "C") = "*.*"
    WSMain.Cells(14, "F") = "Deleting"
    'MaxRowM = MaxRowM + 1
End If

Application.ScreenUpdating = False

DeleteFiles gstDestinationFolder

Set rgStart = Range("E5")
'startDate = Range("C2").Value
'stopdate = Range("C3").Value

For xx = dStartDate To dEndDate

    If HttpExists(sHTTP & Format(xx, "ddmmyyyy") & ".csv") Then
        txtFileName = Format(xx, "ddmmyyyy")
        lastDate = xx
        
        Set WkBk = Workbooks.Add
    
        With ActiveSheet.QueryTables.Add(Connection:="URL;" & sHTTP & Format(xx, "ddmmyyyy") & ".csv", Destination:=Range("$A$1"))
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlEntirePage
            .WebFormatting = xlWebFormattingNone
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
        Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=False, Comma:=True, Space:=False, Other:=False
        Application.DisplayAlerts = False
        WkBk.SaveAs Filename:=gstDestinationFolder & txtFileName & ".csv", FileFormat:=xlCSV, CreateBackup:=False
        WkBk.Close (False)
        
        '---> Update Trace
        If Not bTrace Then
            Application.ScreenUpdating = True
            WSMain.Cells(14, "A").EntireRow.Insert
            WSMain.Cells(14, "A") = "Index"
            WSMain.Cells(14, "B") = gstDestinationFolder
            WSMain.Cells(14, "C") = txtFileName & ".csv"
            WSMain.Cells(14, "F") = "Created"
            'MaxRowM = MaxRowM + 1
            DoEvents
            Application.ScreenUpdating = False
        End If
        
        Application.DisplayAlerts = True
    End If

Next xx

rgStart.Value = DateAdd("d", 1, lastDate)
Application.ScreenUpdating = True

End Sub


Function FormatingIndex(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 dDates
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.Range("B" & WS.Rows.Count).End(xlUp).Row
    MaxCol = WS.UsedRange.Columns.Count
    
        
    '---> Create Text File depending on Origin requested.
    Select Case sType
        Case "Index"
            sTextFile = Mid(sFile, 1, Len(sFile) - 3) & "txt"
            Res = CreateTXTEquity(WS, sDirName & sTextFile, MaxRow, sType)
        
    End Select
    
    If Not bTrace Then
        '---> Disable Trace
        With Application
             .ScreenUpdating = False
        End With
    
        WSMain.Activate
    
        '---> enable Trace
        With Application
             .ScreenUpdating = True
        End With
    End If
        
    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
    
    '---> Disable Trace
    With Application
         .ScreenUpdating = False
    End With
        
    '---> Save workbook
    WB.Close savechanges:=True
    
    '---> If TXT successful then delete CSV
    If Res <> "" Then
        Kill (sDirName & sFile)
        
        '---> Enable Trace
        With Application
             .ScreenUpdating = True
        End With
        
        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
        
        '---> Disable Trace
        With Application
             .ScreenUpdating = False
        End With
    End If
    
    '---> 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
FormatingIndex = ""
Exit Function

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

End Function

Open in new window


4) SAVE and exit the workbook
5) Open it and try it.

gowflow
Naresh PatelFinancial AdviserAuthor Commented:
2) goto VBA and doubleclick on module aStartIndex and delete all the code that is there
 3) Paste the below code there in that module.

Do I have to delete aStartEquityBSE all code before pasting above code to aStartIndex?

Thank You
gowflowCommented:
Nooo
just astartIndex as I assume that you already delete in astartequityBSE and already installed the code that I posted before.

So in summary if the version you have does not have both module code then delete both module code and put the code respectively in each module that is posted.

gowflow
Naresh PatelFinancial AdviserAuthor Commented:
:( Same Story..Keep On Processingdo you want me to give remote of my PC?

Thanks
gowflowCommented:
Are you by any chance getting mixed in the dates ???
You need to put from April 1 2015 in Col E and to April 30 2015 in Col F

as I see you have May 5 till May 4 !!!???

More we are fixing here Index button I see April in the orange Future button. we are working on the third button from the top.
gowflow
Naresh PatelFinancial AdviserAuthor Commented:
Same Story.
gowflowCommented:
Please explain What you do exactly and what happens
gowflow
gowflowCommented:
Please post what code you have under commandbutton3 in sheet Main (goto VBA doubleclick on sheet main locate code of button3 and poste it here

gowflow
Naresh PatelFinancial AdviserAuthor Commented:
1) Downloaded File from your last post in which there is latest version i.e. 27
2) In cell E5 entered date 1 April 2015.
3) Clicked On Index Button.
4) .csv files being downloaded till last available file in server.
5) Stuck.....Processing....Nothing Happen
gowflowCommented:
what is latest version 27 ?
gowflow
Naresh PatelFinancial AdviserAuthor Commented:
yes
gowflowCommented:
Just one issue open the workbook and goto VBA and doubleclick on Thisworkbook pls paste here the code that is in the Private Sub Workbook_Open()

You did not paste here the code that is in Commandbutton3 as I asked you to do
gowflow
Naresh PatelFinancial AdviserAuthor Commented:
Private Sub CommandButton3_Click()
bTrace = CheckBox21.Value
bAudit = CheckBox22.Value
bDelete = CheckBox3.Value
gstDestinationFolder = Range("B5")
If bTesting Then gstDestinationFolder = ActiveWorkbook.Path & "\Temp\"
dStartDate = Range("E5")
dEndDate = Range("F5")
sHTTP = Sheets("Settings").Range("B4")

'---> Import Files
ImportIndex

'---> Formating Future
FormatingIndex CommandButton3.Caption, gstDestinationFolder

If Not bDoit Then
    MsgBox "Index Done"
End If

End Sub

Open in new window

Naresh PatelFinancial AdviserAuthor Commented:
Private Sub Workbook_Open()
'bTesting = True
Sheets("Main").Activate
End Sub

Open in new window

gowflowCommented:
All the code is fine.

Question
Did the version that we posted here V26 was working fine except for Index ?

If yes then download again this version and give it a name 26-A then follow what is on ID: 40757303

As I did exactly this here and tested it and it works perfect.y.
gowflow
Naresh PatelFinancial AdviserAuthor Commented:
i had done comprehensive check for all buttons except last one which do Future & option together. All buttons working well. i had checked all files for each buttons and all is good with proper date except Index Button.

i had 1st downloaded file from This ID.
and done steps as you mentioned in your this ID (Post).

but issue remain same.

Thank You
gowflowCommented:
ok try this
at line 103 of post ID: 40757303 comment out this instruction like put a single quote before it so it become
'Resume

save the workbook and close it then try again. maybe you will get an error, try to see what instruction turns yellow and let me know or if it works then its fine. Maybe it is that you are using a different version of excel that behave differently.

gowflow
Naresh PatelFinancial AdviserAuthor Commented:
By doing this  -

Process go ahead and ended successfully - But in Index Folder location some files get converted to txt i.e. which is after 12 some still remain as .csv.Folder LocationThank You
gowflowCommented:
ok it seems we are hitting an error for the days 1 to 12
pls put after line 103 this
103 'Resume
104 msgbox(Error(err))
105 Resume Next
106 End Function

and run it again. It will pop error when the error message comes out try to interrupt the program CTRL Break before saying ok to the msgbox so we see what line it is

and report the error description and the line.
gowflow
Naresh PatelFinancial AdviserAuthor Commented:
Did as you described.

1) File being Downloaded.
2) After Downloading pop message - waited for 30 sec nothing happen so clicked 49 times and .txt file being created for the date 1 April 2015.
3) Same popup message for each and every file till date 12 April 2015 which I had clicked for 49 times each.
4) From date 13 no popup message running smooth but no popup message at the end which was I m getting previously i.e. "Index Done"
5) Checked file From 13 till 30 all good but rest have some weirdo date.Weirdo DateThank You Sir
ProfessorJimJamMicrosoft Excel ExpertCommented:
@gowflow

Hat's off to you!  

this post, became one of my favorite.
Naresh PatelFinancial AdviserAuthor Commented:
Actually i   ....twice read your every post ....twice check every step......then frame words properly then post.....as i think you too much involved and spent lot of time ....if i do any silly mistake then you gona kill me :).... longest comments ever .....any one can get pissed of ....   actually hats off to you Sir.
gowflowCommented:
No problem I like to deliver a working solution and will stick till it works.

1) You did not mention what the error says
2) What is the line that turns yellow in the code.

I suspect you have a different setting in regional settings and date formatting but will see this later once you confirm the above 2 points.
gowflow
Naresh PatelFinancial AdviserAuthor Commented:
Actually there is no error message pop up, only popup box which I clicked.PopUp Box
Thank You
gowflowCommented:
ok once the popup shows press on CTRL and while holding it press on Break button on your pc then click on the ok button and the program will halt and you will see the yellow line either on the msgbox instruction or the resume next instruction.

what you do now put a quote just before the word next so the instruction become Resume 'Next
if the yellow is on resume press F8 then it will go to the instruction that cause the error and give me a snapshot of the screen when this instruction is yellowed.

gowflow
Naresh PatelFinancial AdviserAuthor Commented:
Here it isSteps as per your instructionLast F8 leads to this WB with popup box. clicked amny time i.e. more than 60 times. Nothing happen it is infinite.Thank You
gowflowCommented:
ok I see

please when the instruction is like in snapshot 3
then do the following
Press F8 it will go to next instruction
WS.Range("B" & I) = dTmp

OOOPPPSS
Just edited this reply. Obviously when you press F8 it will not go to next statement as you have an error.

Please in the immediate window put the following
?vTmp(0)
and press enter and note the value

?vTmp(1)
and press enter and note the value (could be an error)

?vTmp(2)
and press enter and note the value (could be an error)

?WS.Range("B" & I)
and note the value

and advise the values of these 4

gowflow
Naresh PatelFinancial AdviserAuthor Commented:
values
gowflowCommented:
ok great I need the value of
WS.Range("B" & I)

Prior to the error like in this one
WS.Range("B" & I) = Replace(WS.Range("B" & I), "-", "/")

so you can click on this instruction and press F9 it will turn brown and then when it get there you give me like you did value of WS.Range("B" & I)

then press F8 and check again value of
WS.Range("B" & I)

gowflow
gowflowCommented:
one more request
open control panel
choose Region and Language

take a snapshot of the settings in the first tab Formats and post it. I think here is our problem.

gowflow
Naresh PatelFinancial AdviserAuthor Commented:
Surely Doing in Minute ....one suggestion if you are ok with ...take my remote.

Thanks
gowflowCommented:
no need will fix it don't worry unless if you are fedup then its different.
gowflow
Naresh PatelFinancial AdviserAuthor Commented:
Nope I don't ...
gowflowCommented:
Waiting for your input and snapshot and values
gowflow
Naresh PatelFinancial AdviserAuthor Commented:
WS.Range("B"Thank You
gowflowCommented:
Regional settings ?
gowflow
gowflowCommented:
Need to step out will only attend in couple of hours. Meantime if in Region settings short date is not M/d/yyyy try putting this and then run the file and see if it fix it.
put a quote at msgbox so it does not stop at every line.
gowflow
Naresh PatelFinancial AdviserAuthor Commented:
Region SettingThank You
gowflowCommented:
Did you change dd-MMM-yy in short date to M/d/yyyy ?
did it work ?

gowflow
Naresh PatelFinancial AdviserAuthor Commented:
Extremely sorry Sir.  Just went down to play with Kid. Yes I had tried but won't worked .
Naresh PatelFinancial AdviserAuthor Commented:
I am back ......shall we proceed ?
gowflowCommented:
you have put the short date as M/d/yyyy and what happened ?
gowflow
Naresh PatelFinancial AdviserAuthor Commented:
Eureka all files with proper date format but I did it earlier but that time not fix ....may be require system restart to amend changes so in 2nd attempt it work fine ....let me do it for longer period ....Apology I said it dint work :(  ....need to change some thing in code as you said
ok it seems we are hitting an error for the days 1 to 12
 pls put after line 103 this
 103 'Resume
 104 msgbox(Error(err))
 105 Resume Next
 106 End Function


???

Thank You
gowflowCommented:
ok this is not final !!!!

put back the code the way it was before

Resume
End Function

try it and try the other buttons if it works then I will need to fix it so you can use and date format that you like ie
dd-MMM-yy

let me know
gowflow
Naresh PatelFinancial AdviserAuthor Commented:
All Done Perfectly With Proper FormateThank You
gowflowCommented:
Are you ok with keeping short date format as M/d/yyyy or you need dd-MMM-yy ?
gowflow
Naresh PatelFinancial AdviserAuthor Commented:
i don't mind ......so if I open this file in different PC then I have to change date setting ...right ? that's it...?

one more thing what is the reason it behaving like that as in whole WB there are 2 or 3 more subs with create .txt file and they work perfect but only this Index thing wont ....just for my knowledge so in future I ll take care of this.

Thanks
gowflowCommented:
Well this problem is not your fault and any setting in the regional settings should not affect the results.

I believe for some reason the site where you pull the data for the Index have decided to put the dates in the csv file in a different format than the other sites. Meaning in an unformatted way. The date that is put there is put I believe as text and to top it all out it is put as D/M/yy this is why in the April 1st you see the date 1/4/2015 and when you changed your regional setting to be dd-MMM-yy it was translated as 04-Jan-2015 and not 01-Apr-2015 as it should be.

If the date was showing 01-Apr-2015 on this site then no need for all the corrective routine and whatever setting you would do in Regional setting the macro would still naturally work as when it hit this instruction
TEXT(B2,""YYYYMMDD"")
it would naturally convert the date to 20150401 as it is doing on all other sites. But here because the date is wrong and is 04-Jan-2014 the conversion is done till month 12 (or day 12) and hitting errors from 13 to 31 and in setting like mine M/d/yy I had okay from 01 to 12 then error from 13 to 31.

So the routine in fact is writing in the file the correct date like it is switching month and day.

I can still fix this and let you keep dd-MMM-yy but need to know from you if it is the case.
gowflow
Naresh PatelFinancial AdviserAuthor Commented:
Sir.Gowflow,

This is my Trading laptop so I don't mind to set any date format. But  what you said is handy then amend, else leave it.
as too much of time invested in this tread.

Thanks
gowflowCommented:
Yes you are correct. I tried to amend the code to work both ways but it worked on dd-MMM-yy and when reverted back to M/d/yy it worked for day 1 to 12 but not 13 to 31

So my suggestion leave your setting to M/d/yy as you have a working version for all sites.

This one was a tough one to handle.
gowflow
Naresh PatelFinancial AdviserAuthor Commented:
ok then I am happy with this.

and thank you so much

and I thought you had posted this so i replied this.

Again Hatt's Off to you and thank you.
gowflowCommented:
Your welcome
but Sorry don't understand the link to last thread.
gowflow
Naresh PatelFinancial AdviserAuthor Commented:
I thought you said
ProfessorJimJam2015-05-05 at 14:44:14ID: 40759740




@gowflow

 Hat's off to you!  

 this post, became one of my favorite.
and I replied
itjockey2015-05-05 at 14:51:31ID: 40759787




Actually i   ....twice read your every post ....twice check every step......then frame words properly then post.....as i think you too much involved and spent lot of time ....if i do any silly mistake then you gona kill me :).... longest comments ever .....any one can get pissed of ....   actually hats off to you Sir.

Thanks
gowflowCommented:
No it's
ProfessorJimJam who did comment.

Tks for the appreciation. Indeed one of the longer thread question. But glad it is at least working now. I don't like a question to be closed and points awarded but solution not working.

We can now turn the page on this one.
gowflow
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.