Link to home
Start Free TrialLog in
Avatar of Naresh Patel
Naresh PatelFlag for India

asked on

Follow Up FO

Hi Experts,

I have one Peace of code which make some changes in my .csv file. need to add some more steps in this code. 
Function FormatingFO(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
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.UsedRange.Rows.Count
    MaxCol = WS.UsedRange.Columns.Count
    
    '---> Find Criteria Dates
    WS.UsedRange.AutoFilter field:=2, Criteria1:="NIFTY"
    WS.UsedRange.AutoFilter field:=5, Criteria1:="XX"
    
    For I = 2 To MaxRow
        If WS.Range("A" & I).EntireRow.Hidden = False Then
            If sdates <> "" Then sdates = sdates & ";"
            sdates = sdates & DateValue(WS.Cells(I, "C"))
            J = J + 1
        End If
    Next I
            
    dDates = Split(sdates, ";")
    sdates = ""
    
    '---> Loop Thru all the Criteria
    For I = LBound(dDates) To UBound(dDates)
        If WS.AutoFilterMode = True Then WS.ShowAllData
        
        '---> Apply Filter
        WS.UsedRange.AutoFilter field:=3, Criteria1:=">=" & dDates(I), Operator:=xlAnd, Criteria2:="<=" & dDates(I)
        
        '---> 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
        
        '---> Change Date in Col C by coresponding letter
        Select Case I
            Case 0
                sDate = "I"
            Case 1
                sDate = "II"
            Case 2
                sDate = "III"
            Case Else
                sDate = "I" & Str(I)
        End Select
        
        lUns = 0
        For J = 2 To MaxRow
            If WS.Range("A" & J).EntireRow.Hidden = False Then
                WS.Range("C" & J) = sDate
                lUns = lUns + 1
            End If
        Next J
        
        '---> Register the record found in Audit
        If Not bAudit Then
            WSAudit.Cells(MaxRowA, "A") = Now
            WSAudit.Cells(MaxRowA, "B") = sFile
            WSAudit.Cells(MaxRowA, "C") = dDates(I) & " " & sDate
            WSAudit.Cells(MaxRowA, "D") = Rng.Address
            MaxRowA = MaxRowA + 1
        End If
        
        '---> 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
            WSMain.Cells(14, "D") = sDate
            WSMain.Cells(14, "E") = lUns
            WSMain.Cells(14, "F") = "Formated"
        End If
        DoEvents
    Next I
    
    '---> Delete All rows that have a date in Col C
    For I = MaxRow To 2 Step -1
        If IsDate(WS.Cells(I, "C")) Then
            WS.Range("C" & I).EntireRow.Delete
            lRows = lRows + 1
        End If
    Next I
    
    If Not bAudit Then
        WSAudit.Cells(MaxRowA, "A") = Now
        WSAudit.Cells(MaxRowA, "B") = sFile
        WSAudit.Cells(MaxRowA, "C") = Deleted & lRows & " Rows"
        MaxRowA = MaxRowA + 1
    End If
        

    '---> Update Trace Status
    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, "E") = lRows
        WSMain.Cells(14, "F") = "Deleted"
    End If
    
    '---> Remove Filtering
    WS.ShowAllData
    WS.AutoFilterMode = False
    'WS.UsedRange.EntireColumn.AutoFit
        
    '---> Save workbook
    WB.Close savechanges:=True
    
    '---> 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
FormatingFO = ""
Exit Function

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

End Function

Open in new window

Above is my existing code need to add more steps which below listed.
Step 1 Add this text in Cell P1 "Ticker,Date,Open,High,Low,Close,Volume,OI"
Step 2 Add this formula in cell P2 "=IF(OR(A2="FUTSTK",A2="FUTIDX"),B2&" "&C2&","&TEXT(O2,"DD-MMM-YY")&","&F2&","&G2&","&H2&","&I2&","&K2&","&M2,IF(OR(A2="OPTIDX",A2="OPTSTK"),B2&" "&C2&" "&D2&" "&E2&","&TEXT(O2,"DD-MMM-YY")&","&F2&","&G2&","&H2&","&I2&","&K2&","&M2,""))" and formula drop down till end.
Step 3 Sort column P A to Z except header.
Step 4 Copy column P1 till end & past to new .txt file and save and name as .csv file name &Close.
Step 5 delete actual .csv file.
Step 6 End

See attached
After.xlsx
Final-File.txt
Avatar of Jacques Geday
Jacques Geday
Flag of Canada image
Question


Step 3 Sort column P A to Z except header.

On what field or column ?
gowflow
Avatar of Naresh Patel
Naresh Patel
Flag of India image

ASKER

Column.
Avatar of Jacques Geday
Jacques Geday
Flag of Canada image
Yes I know but which one ??? !!!!
gowflow
Avatar of Jacques Geday
Jacques Geday
Flag of Canada image
Separate note.
When you run from date to date ultimately in this folder you will have several csv that you want to all process format FO then additional format saving txt correct ???

gowflow
Avatar of Naresh Patel
Naresh Patel
Flag of India image

ASKER

Column P sort AToZ
Yes - Each .csv have diffrent name. Formats and create .txt file for each .csv and delete original .csv one by one .

Thanks
Avatar of Jacques Geday
Jacques Geday
Flag of Canada image
ok here it is:

1) Make a new copy of your latest production workbook and give it a new name.
2) goto VBA and double click on the module 'aStartFO'
3) Select ALL the code that is in this module and DELETE IT.
4) Paste the Below code in this module (it consist of 2 Functions: Formating FO, CreateTXT)

Function FormatingFO(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
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.UsedRange.Rows.Count
    MaxCol = WS.UsedRange.Columns.Count
    
    '---> Find Criteria Dates
    WS.UsedRange.AutoFilter field:=2, Criteria1:="NIFTY"
    WS.UsedRange.AutoFilter field:=5, Criteria1:="XX"
    
    For I = 2 To MaxRow
        If WS.Range("A" & I).EntireRow.Hidden = False Then
            If sdates <> "" Then sdates = sdates & ";"
            sdates = sdates & DateValue(WS.Cells(I, "C"))
            J = J + 1
        End If
    Next I
            
    dDates = Split(sdates, ";")
    sdates = ""
    
    '---> Loop Thru all the Criteria
    For I = LBound(dDates) To UBound(dDates)
        If WS.AutoFilterMode = True Then WS.ShowAllData
        
        '---> Apply Filter
        WS.UsedRange.AutoFilter field:=3, Criteria1:=">=" & dDates(I), Operator:=xlAnd, Criteria2:="<=" & dDates(I)
        
        '---> 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
        
        '---> Change Date in Col C by coresponding letter
        Select Case I
            Case 0
                sDate = "I"
            Case 1
                sDate = "II"
            Case 2
                sDate = "III"
            Case Else
                sDate = "I" & Str(I)
        End Select
        
        lUns = 0
        For J = 2 To MaxRow
            If WS.Range("A" & J).EntireRow.Hidden = False Then
                WS.Range("C" & J) = sDate
                lUns = lUns + 1
            End If
        Next J
        
        '---> Register the record found in Audit
        If Not bAudit Then
            WSAudit.Cells(MaxRowA, "A") = Now
            WSAudit.Cells(MaxRowA, "B") = sFile
            WSAudit.Cells(MaxRowA, "C") = dDates(I) & " " & sDate
            WSAudit.Cells(MaxRowA, "D") = Rng.Address
            MaxRowA = MaxRowA + 1
        End If
        
        '---> 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
            WSMain.Cells(14, "D") = sDate
            WSMain.Cells(14, "E") = lUns
            WSMain.Cells(14, "F") = "Formated"
        End If
        DoEvents
    Next I
    
    '---> Delete All rows that have a date in Col C
    For I = MaxRow To 2 Step -1
        If IsDate(WS.Cells(I, "C")) Then
            WS.Range("C" & I).EntireRow.Delete
            lRows = lRows + 1
        End If
    Next I
    
    '---> Get the New Maximum Rows
    MaxRow = WS.UsedRange.Rows.Count
    
    If Not bAudit Then
        WSAudit.Cells(MaxRowA, "A") = Now
        WSAudit.Cells(MaxRowA, "B") = sFile
        WSAudit.Cells(MaxRowA, "C") = Deleted & lRows & " Rows"
        MaxRowA = MaxRowA + 1
    End If
        

    '---> Update Trace Status
    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, "E") = lRows
        WSMain.Cells(14, "F") = "Deleted"
    End If
    
    '---> Remove Filtering
    WS.ShowAllData
    WS.AutoFilterMode = False
    'WS.UsedRange.EntireColumn.AutoFit
    
    '---> Create Text File
    Res = CreateTXT(WS, sDirName & Mid(sFile, 1, Len(sFile) - 3) & "txt", MaxRow)
    
    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") = Mid(sFile, 1, Len(sFile) - 3) & "txt"
            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
    
    '---> 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
FormatingFO = ""
Exit Function

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

End Function


Function CreateTXT(WS As Worksheet, sWBName As String, MaxRow As Long) As String
On Error GoTo ErrCreateTXT

'---> Title In P1
'"Ticker,Date,Open,High,Low,Close,Volume,OI"
WS.Range("P1") = "Ticker,Date,Open,High,Low,Close,Volume,OI"

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

'---> Sort as per Col P
WS.Range("A1:P" & MaxRow).Sort key1:=WS.Range("P1"), order1:=xlAscending, Header:=xlYes, MatchCase:=no
WS.Range("P2:P" & MaxRow).Copy
WS.Range("P2").PasteSpecial xlPasteValues

WS.Range("A:O").EntireColumn.Delete
WS.Range("A1:A" & MaxRow).Select
WS.SaveAs Filename:=sWBName ', FileFormat:=xlTextWindows

CreateTXT = sWBName

Set WS = Nothing
Exit Function

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

Open in new window

5) SAVE the workbook and close it.
6) Open it and Give it a try.

Let me know
gowflow
Avatar of Naresh Patel
Naresh Patel
Flag of India image

ASKER

Working Perfect But May Be One Line Need To change In Code I Guess. As I Got Results In .Txt File In "Result" i.e. Inverted Coma.User generated image
Thanks
Avatar of Jacques Geday
Jacques Geday
Flag of Canada image
Inverted coma ??? what is this ? sorry don't understand what is the problem.
gowflow
Avatar of Jacques Geday
Jacques Geday
Flag of Canada image
ok here it is:

In the sub CreateTXT pls change this line

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

Open in new window


by this line
WS.Range("P2:P" & MaxRow).Formula = "=IF(OR(A2=""FUTSTK"",A2=""FUTIDX""),B2&"",""&C2&"",""&TEXT(O2,""DD-MMM-YY"")&"",""&F2&"",""&G2&"",""&H2&"",""&I2&"",""&K2&"",""&M2,IF(OR(A2=""OPTIDX"",A2=""OPTSTK""),B2&"",""&C2&"",""&D2&"",""&E2&"",""&TEXT(O2,""DD-MMM-YY"")&"",""&F2&"",""&G2&"",""&H2&"",""&I2&"",""&K2&"",""&M2,""""))"

Open in new window


gowflow
Avatar of Naresh Patel
Naresh Patel
Flag of India image

ASKER

Sorry For Delay - Both Are Identical Lines.

Thanks
Avatar of Jacques Geday
Jacques Geday
Flag of Canada image
No not at all !!!
put the second and try the file the first 3 items are missing a comma is this the problem ??
gowflow
Avatar of Naresh Patel
Naresh Patel
Flag of India image

ASKER

i had replaced line as per your suggestion but still I am getting same result.

I don't want "ABIRLANUVO,I,06-Jan-15,1748.95,1752.95,1685.6,1693.25,1757,1625000"
" inverted commas.User generated image
Thanks
Avatar of Jacques Geday
Jacques Geday
Flag of Canada image
You mean the quotes !!! starting and ending ?
gowlfow
ASKER CERTIFIED SOLUTION
Avatar of Jacques Geday
Jacques Geday
Flag of Canada image
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Naresh Patel
Naresh Patel
Flag of India image

ASKER

Perfect.....Too late here I will post link of follow up over here .....3 question in line for this WB. Will post tomorrow.

Thanks
Avatar of Jacques Geday
Jacques Geday
Flag of Canada image
Tomorrow there will be a delay so if you need my assistance prefer you wait a sign from me.
gowflow
Avatar of Naresh Patel
Naresh Patel
Flag of India image

ASKER

Ok....Buzz me over here . Then I will post.
Avatar of Jacques Geday
Jacques Geday
Flag of Canada image
ok back !
gowflow
Avatar of Naresh Patel
Naresh Patel
Flag of India image

ASKER

May I now?