Solved

Del Formatting

Posted on 2014-12-28
6
120 Views
Last Modified: 2014-12-29
Hi Experts,

I have One WB which downloads files from web, need to add some procedure after downloading on those files.
I am describing Step by step
1 Delete first 3 rows
2 Delete rows which have other than "BE" & "EQ" in column D except Header.
3 Next File till Last file.

See attached WB

Thanks
Del-D-V01.xlsm
0
Comment
Question by:itjockey
  • 3
  • 2
6 Comments
 
LVL 23

Expert Comment

by:Michael74
ID: 40521042
I can help with the macro but the site for example http://nseindia.com/archives/equities/mto/MTO_29122014.dat does not return data for me (I suspect you need an account) and so I cannot see the data returned

Could you post an example with the data input from the current macro
0
 
LVL 8

Author Comment

by:itjockey
ID: 40521314
here is the sample files ....attaching 3.

My files location is "D:\AmiBroker Data\NSE\Del"

it is free site I don't know why it does not return to data. may be for different location it may required account.

Thanks
23122014.csv
24122014.csv
26122014.csv
0
 
LVL 29

Accepted Solution

by:
gowflow earned 500 total points
ID: 40521467
Is this what you want ?? Basically this below code should do it, The below workbook has been updated to include the whole process with the Delete Row sheet that sets the criterias.

pls find the code herewith

Function DelSpecRowCSV() As String
On Error GoTo ErrHandler

Dim WB As Workbook
Dim WS As Worksheet
Dim WSDelRows As Worksheet
Dim MaxRow As Long, MaxCol 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
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

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


For Each vFile In colFiles
           
    '---> Get full name
    sFile = Dir(vFile)
    sDirName = Mid(vFile, 1, InStrRev(vFile, "\"))
    
    
    '---> 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
    WS.Range("1:3").EntireRow.Delete
    MaxRow = WS.UsedRange.Rows.Count
    MaxCol = WS.UsedRange.Columns.Count
    
    
    
    '---> Loop Thru all the Criteria
    For I = 2 To MaxRowE Step 2
        If WS.AutoFilterMode = True Then WS.ShowAllData
        WS.Range("H3").AutoFilter field:=WSDelRows.Cells(I, "B"), Criteria1:=WSDelRows.Cells(I, "A"), Operator:=xlAnd, Criteria2:=WSDelRows.Cells(I + 1, "A")
    
        '---> 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
        
        lUns = lUns + 1
                
        '---> 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
        
    Next I
    
        
    '---> Save workbook
    WB.Close savechanges:=True
    
    '---> reset Variables
    Set WS = Nothing
    Set WB = Nothing
    Set Rng = Nothing
    lUns = 0
    lRows = 0
    
Next vFile

'---> Enable Events
With Application
    .EnableEvents = True
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
    
'---> Set Flag to complete successful and exit
DelSpecRowCSV = ""
MsgBox "Process Completed."

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


Let me know your comments.
gowflow
Del-D-V02.xlsm
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 8

Author Closing Comment

by:itjockey
ID: 40521549
Perfect - May Carry On With New Question?

Thanks
0
 
LVL 29

Expert Comment

by:gowflow
ID: 40521553
Yes pls do
gowflow
0
 
LVL 8

Author Comment

by:itjockey
ID: 40521565
Here it is Incorporate Eq - Del.

Thanks
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In this article we discuss how to recover the missing Outlook 2011 for Mac data like Emails and Contacts manually.
Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

756 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question