PDA

View Full Version : Solved: batch macro to delete rows



asddsa88
01-10-2012, 06:26 AM
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
01-10-2012, 12:18 PM
hi.

test with copies of files....


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

asddsa88
01-11-2012, 04:38 AM
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.)


compile error:
invalid next control variable reference


(debugger highlights "ws" in line 30)


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

thanks in advance

mancubus
01-11-2012, 05:33 AM
sorry.
one "Next" (Next i) is missing.


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

mancubus
01-11-2012, 05:40 AM
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

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

asddsa88
01-11-2012, 01:21 PM
Thanks for the reply, I am still getting an error though:

Compile error: Variable not defined

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

mancubus
01-11-2012, 02:55 PM
Option Explicit requires all variables must be declared.
so add ", i As Long" to third line.
sorry for that...

Dim LastRow As Long, Calc As Long, i As Long

asddsa88
01-12-2012, 05:46 AM
Ok, we are getting there!
Now my full code is:

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


2 questions:

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


this:

If Application.CountIf(Rows(i), srcStr) = 0 Then
Rows(i).Delete
End If

with this: (to search only in column D instead of the whole document)

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

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
01-12-2012, 07:08 AM
2)


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

mancubus
01-12-2012, 07:25 AM
1)

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

deletes rows if cell in Col D contains "XXX"

(re to condition i asked in post#5)

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

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
If Cells(i, "D").Value <> srcStr Then
Rows(i).Delete
End If


both versions worked for me..

asddsa88
01-13-2012, 01:12 PM
what can I say?

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

mancubus
01-14-2012, 03:46 PM
you're wellcome...

wakdafak
01-16-2012, 12:00 AM
nice one mancubus... that really help me also...thanks

edwardn
11-02-2018, 08:52 PM
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