Del Formatting

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
LVL 8
Naresh PatelTraderAsked:
Who is Participating?
 
gowflowConnect With a Mentor Commented:
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
 
Michael FowlerSolutions ConsultantCommented:
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
 
Naresh PatelTraderAuthor Commented:
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
The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

 
Naresh PatelTraderAuthor Commented:
Perfect - May Carry On With New Question?

Thanks
0
 
gowflowCommented:
Yes pls do
gowflow
0
 
Naresh PatelTraderAuthor Commented:
Here it is Incorporate Eq - Del.

Thanks
0
All Courses

From novice to tech pro — start learning today.