Solved: batch macro to delete rows

[asddsa88]

Hello,

I spent the last 2 days trying to figure out how to do this, even without excel.. unfortunately no luck, so I am trying with macros now.

I have a folder with many files (.xls). Inside this files there are many rows.
I need a macro to open all the files inside a folder and to delete all the rows that do not contain a XXX value.

Then I will execute the macro through a batch script (which I am already able to).

Do you have any idea on how to do this?

[mancubus]

hi.

test with copies of files....

[VBA]
Sub DelRowsAllFiles()
'http://vbaexpress.com/forum/showthread.php?t=40451

Dim wb As Workbook
Dim ws As Worksheet
Dim LastRow As Long
Dim fPath As String, fName As String, srcStr As String

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

srcStr = "XXX"

fPath = "C:\My Folder\Data\" 'change to suit
If Right(fPath, 1) <> "\" Then fPath = fPath & "\"

fName = Dir(fPath & "*.xls*")

Do Until fName = ""
If fName <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(fPath & fName)
For Each ws In wb.Worksheets
LastRow = ws.Cells.SpecialCells(xlCellTypeLastCell).Row
For i = LastRow To 2 Step -1
If Application.CountIf(Rows(i), srcStr) = 0 Then
Rows(i).Delete
End If
Next ws
wb.Save
wb.Close
End If
fName = Dir()
Loop

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

End Sub
[/VBA]

[asddsa88]

Hello mancubus, thanks for the input.

I have 2 questions:

1) The debugger gives me an error when executing your macro (only changes were: macro name changed + folder path for xls repository changed.)

[vba]
compile error:
invalid next control variable reference


(debugger highlights "ws" in line 30)

[/vba]
2) Could I change that macro to look for my Srcstr only in column D of the xls documents?

thanks in advance

[mancubus]

sorry.
one "Next" (Next i) is missing.

[vba]
Option Explicit

Sub DelRowsAllFiles()
'http://vbaexpress.com/forum/showthread.php?t=40451

Dim wb As Workbook
Dim ws As Worksheet
Dim LastRow As Long, Calc As Long
Dim fPath As String, fName As String, srcStr As String

With Application
.Displayalerts = False
.EnableEvents = False
.ScreenUpdating = False
Calc = .Calculation
.Calculation = xlCalculationManual
End With

srcStr = "XXX"

fPath = "C:\My Folder\Data\" 'change to suit
If Right(fPath, 1) <> "\" Then fPath = fPath & "\"

fName = Dir(fPath & "*.xls*")
Do Until fName = ""
If fName <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(fPath & fName)
For Each ws In wb.Worksheets
LastRow = ws.Cells.SpecialCells(xlCellTypeLastCell).Row
For i = LastRow To 2 Step -1
If Application.CountIf(Rows(i), srcStr) = 0 Then
Rows(i).Delete
End If
Next i
Next ws
wb.Save
wb.Close
End If
fName = Dir()
Loop

With Application
.Displayalerts = True
.EnableEvents = True
.ScreenUpdating = True
.Calculation = Calc
End With

End Sub
[/vba]

[mancubus]

and second question....

you'd like to delete a row, if specific value exists in col D cell of that row?

if so change the condition in For (i) Next Loop
[VBA]
If Cells(i, "D").Value = srcStr Then
Rows(i).Delete
End If

[/VBA]

[asddsa88]

Thanks for the reply, I am still getting an error though:

[VBA]Compile error: Variable not defined

[line 30 - "i" is highlighted][/VBA]
any ideas?

[mancubus]

Option Explicit requires all variables must be declared.
so add ", i As Long" to third line.
sorry for that...

[VBA]Dim LastRow As Long, Calc As Long, i As Long[/VBA]

[asddsa88]

Ok, we are getting there!
Now my full code is:
[vba]
Option Explicit

Sub DelRowsAllFiles()
'http://vbaexpress.com/forum/showthread.php?t=40451

Dim wb As Workbook
Dim ws As Worksheet
Dim LastRow As Long, Calc As Long, i As Long
Dim fPath As String, fName As String, srcStr As String


With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
Calc = .Calculation
.Calculation = xlCalculationManual
End With

srcStr = "XXX"

fPath = "C:\test\" 'change to suit
If Right(fPath, 1) <> "\" Then fPath = fPath & "\"

fName = Dir(fPath & "*.xls*")
Do Until fName = ""
If fName <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(fPath & fName)
For Each ws In wb.Worksheets
LastRow = ws.Cells.SpecialCells(xlCellTypeLastCell).Row
For i = LastRow To 2 Step -1
If Application.CountIf(Rows(i), srcStr) = 0 Then
Rows(i).Delete
End If
Next i
Next ws
wb.Save
wb.Close
End If
fName = Dir()
Loop

With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
.Calculation = Calc
End With

End Sub

[/vba]
2 questions:

1) in the current format the code works, however if I try to swap


this:
[vba]
If Application.CountIf(Rows(i), srcStr) = 0 Then
Rows(i).Delete
End If
[/vba]
with this: (to search only in column D instead of the whole document)
[vba]
If Cells(i, "D").Value = srcStr Then
Rows(i).Delete
End If
[/vba]
Nothing happens. Did I do something wrong?

2) I would like to exclude from deletion the first 8 rows of the document.
Is there a way to do that?

Thanks in advance, your help is highly appreciated!

[mancubus]

2)

[VBA]
For i = LastRow To 9 Step -1
If Application.CountIf(Rows(i), srcStr) = 0 Then
Rows(i).Delete
End If
Next i

[/VBA]

[mancubus]

1)

deletes rows where all cells in that row do not contain "XXX"
[vba]If Application.CountIf(Rows(i), srcStr) = 0 Then
Rows(i).Delete
End If [/vba]

deletes rows if cell in Col D contains "XXX"

(re to condition i asked in post#5)

[vba]If Cells(i, "D").Value = srcStr Then
Rows(i).Delete
End If[/vba]

so if you run the code with two versions one after another on the same files, all rows will be deleted.

Col D equivalent of first one is

[vba]If Cells(i, "D").Value <> srcStr Then
Rows(i).Delete
End If[/vba]


both versions worked for me..

[asddsa88]

what can I say?

you solved all my questions! I really appreciate your effort, have a good one

[mancubus]

you're wellcome...

[wakdafak]

nice one mancubus... that really help me also...thanks

[edwardn]

Sorry if this is a very old post. But my code isnt working...

Its not deleting nor replacing the value. No idea whats wrong.

Sub DelRowsAllFiles()


Dim wb As Workbook
Dim ws As Worksheet
Dim LastRow As Long, Calc As Long, i As Long
Dim fPath As String, fName As String, srcStr As String




With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
Calc = .Calculation
.Calculation = xlCalculationManual
End With


srcStr = "test23"


fPath = Application.ActiveWorkbook.Path 'change to suit
If Right(fPath, 1) <> "\" Then fPath = fPath & "\"


fName = Dir(fPath & "*.xls*")
Do Until fName = ""
If fName <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(fPath & fName)
For Each ws In wb.Worksheets
LastRow = ws.Cells.SpecialCells(xlCellTypeLastCell).Row
For i = LastRow To 2 Step -1


If Cells(i, "A").Value = srcStr Then
'Rows(i).Delete
Cells(i, "A").Value = "Replaced"
End If


Next i
Next ws
wb.Save
wb.Close
End If
fName = Dir()
Loop


With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
.Calculation = Calc
End With


End Sub