Delete data from multipal files using VBA

[ROHTASHSAGAR]

Hi There

I have in a folder 30 excel files (Each file have same tab names)

What I need a vba which will

Go to the folder
Open each file
Go to specific tab (Assuming data tab)
Apply filter in data tab based on some name mentioned in other tab (Criteria Tab cell value B6) it will be same file
delete all records not equal to (Criteria Tab cell value B6)
then save and close the file
move to another file

repeat this until all files are done in folder

any one pls help

Regards
Ro

 

[ranman256]

be sure to set the tab name where the criteria is located
and where the cell is that matches the criteria to delete...here its ActiveCell.Offset(0, 2).Value (col 3)

usage: getFilesInDir "c:\folder"

Public Sub getFilesInDir(ByVal pvDir)
Dim FSO, oFolder, oFile, oRX
Dim sCriteria As String, sFile As String


On Error GoTo errGetFiles


If Right(pvDir, 1) <> "\" Then pvDir = pvDir & "\"


Set FSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = FSO.GetFolder(pvDir)


For Each oFile In oFolder.Files
  If InStr(oFile.Name, ".xls") > 0 Then            'open file here
     sFile = pvDir & oFile.Name
     Workbooks.Open sFile
     
                'get criteria  ' Criteria Tab cell value B6
     Sheets("Criteria Tab").Activate
     sCriteria = Range("B6").Value
     
                'now scan the rows
     Sheets("sheet1").Activate
     Range("A1").Select
     FarDown
     While ActiveCell.Value <> ""
        If ActiveCell.Offset(0, 2).Value = sCriteria Then        'if col 3 = "xxx" then delete it
           Delete1Row ActiveCell.Row
        End If
        
        PrevRow
     Wend
     ActiveWorkbook.Save
     ActiveWorkbook.Close
  End If
Next
MsgBox "Done"

endit:
Set oFile = Nothing
Set oFolder = Nothing
Set FSO = Nothing
Exit Sub

errGetFiles:
  MsgBox Err.Description, , Err
End Sub


Private Sub PrevRow()
ActiveCell.Offset(-1, 0).Select
End Sub

Private Sub FarDown()
    Selection.End(xlDown).Select
End Sub

Private Sub Delete1Row(ByVal plRow As Long)
    Rows(plRow & ":" & plRow).Select
    Selection.Delete Shift:=xlUp
End Sub

 

[ROHTASHSAGAR]

Thanks buddy

But seems I messed up on my requirement let me be more clear on this

Go to the folder (Folder path may vary each month so pop up window need to appear to chose path of folder --- Only folder path need to be chosen)
Open each file (Each file one by the number of files may be vary each month)
Go to Criteria tab Cell value B6 and copy this
Go to data tab (data tab)
Apply filter in data tab based on value of cell B6 Criteria tab
delete all records not equal to (Criteria Tab cell value B6)
then save and close the file
move to another file


I tried this code but its disappearing

Thanks

 

[ranman256]

then correct:
If ActiveCell.Offset(0, 2).Value <> sCriteria Then


you cannot save code in a .xlsx file. It will all erase.
macros can only be saved in .xls, or .xlsm

 

[ROHTASHSAGAR]

the file is xls I have already copied the code to module using F11 but there is nthing appearing when we run macro window Pop up

Go to the folder (Folder path may vary each month so pop up window need to appear to chose path of folder --- Only folder path need to be chosen)
Open each file (Each file one by the number of files may be vary each month)
Go to Criteria tab Cell value B6 and copy this
Go to data tab (data tab)
Apply filter in data tab based on value of cell B6 Criteria tab.... in data tab filter needs to applied in column A
delete all rows and records not equal to (Criteria Tab cell value B6)
then save and close the file
move to another file in the same folder