hi again.
in the second workbook first footnote is "1. NOTES" and not "(1) Includes". it throws error on this line. and maybe other workbook have different footnotes. so it will be hard to detect the last row of the worksheets for coding purposes. and considering there are not always 2 blank rows between tables and footnotes, it will be even harder.
but i see a common text in all worksheets which is
Source: X. if it exists at the end of all tables in all worksheets in all workbooks, we can use it to determine the last rows of data tables. but if not, to my knowledge, you should find a pattern which is common to all worksheets.
assuming exists in all worksheets i modified the code as below.
i noticed that the first worksheet is hidden. so i added a few lines to handle it.
Sub Del_Rows_n_Cols_on_Condition_AllWS_AllWB_Same_Folder()
'http://www.vbaexpress.com/forum/showthread.php?48681-Selecting-and-deleting-rows-based-on-criteria
Dim wb As Workbook, ws As Worksheet
Dim fRange As Range, delRng As Range
Dim FirstRowQ As Variant
Dim i As Long, FR As Long, LR As Long, LC As Long
Dim fName, fPath As String
'fPath = "C:\Files\" 'change to suit. include final \
fPath = "C:\Users\Attila\test\beax\" 'change to suit. include final \
fName = Dir(fPath & "*.xls*")
Do While fName <> ""
Set wb = Workbooks.Open(fPath & fName)
For i = 1 To Worksheets.Count
If Worksheets(i).Visible Then
Worksheets(i).Select
Exit For
End If
Next i
FirstRowQ = MsgBox(wb.Name & vbLf & vbLf & "Is the first row the same in each worksheet?", vbYesNoCancel, "First Row Decision")
If FirstRowQ = vbYes Then
Set fRange = Application.InputBox("Please Select the First Row of the Range", "First Row Selection", Type:=8)
FR = fRange.Row
For Each ws In wb.Worksheets
With ws
If .Visible = True Then
LR = .Cells.Find("Source", , , xlPart, xlByRows, xlPrevious).Row - 1
LC = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
Set delRng = .Range(.Cells(FR, 1), .Cells(LR, LC))
delRng.Columns(1).SpecialCells(4).EntireRow.Delete
delRng.AutoFilter Field:=3, Criteria1:=Array("NE", "NW", "YH", "EM", "WM", "E", "L", "IL", "OL", "SE", "SW"), Operator:=xlFilterValues
.AutoFilter.Range.Rows.Delete
.AutoFilterMode = False
.Rows(FR).SpecialCells(4).EntireColumn.Delete 'WARNING: if a cell in a blank row is selected all columns will be deleted.
End If
End With
Next ws
ElseIf FirstRowQ = vbNo Then
For Each ws In wb.Worksheets
With ws
If .Visible = True Then
.Activate
Set fRange = Application.InputBox("Select the first row in each worksheet", "First Row Selection", Type:=8)
FR = fRange.Row
LR = .Cells.Find("Source", , , xlPart, xlByRows, xlPrevious).Row - 1
LC = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
Set delRng = .Range(.Cells(FR, 1), .Cells(LR, LC))
delRng.Columns(1).SpecialCells(4).EntireRow.Delete
delRng.AutoFilter Field:=3, Criteria1:=Array("NE", "NW", "YH", "EM", "WM", "E", "L", "IL", "OL", "SE", "SW"), Operator:=xlFilterValues
.AutoFilter.Range.Rows.Delete
.AutoFilterMode = False
.Rows(FR).SpecialCells(4).EntireColumn.Delete 'WARNING: if a cell in a blank row is selected all columns will be deleted.
End If
End With
Next ws
Else
MsgBox "You cancelled the code execution. Quitting...", vbOKOnly, "QUIT"
wb.Close SaveChanges:=False
Exit Sub
End If
wb.Close SaveChanges:=True
fName = Dir()
Loop
End Sub
or if you dont bother loosing blank rows between tables and footnotes, (and since the cell of that row in Col A is blank) the row that contains the word "Source" as well, you can use the first code.
Sub Del_Rows_n_Cols_on_Condition_AllWS_AllWB_Same_Folder()
'http://www.vbaexpress.com/forum/showthread.php?48681-Selecting-and-deleting-rows-based-on-criteria
Dim wb As Workbook, ws As Worksheet
Dim fRange As Range, delRng As Range
Dim FirstRowQ As Variant
Dim i As Long, FR As Long, LR As Long, LC As Long
Dim fName, fPath As String
'fPath = "C:\Files\" 'change to suit. include final \
fPath = "C:\Users\Attila\test\beax\" 'change to suit. include final \
fName = Dir(fPath & "*.xls*")
Do While fName <> ""
Set wb = Workbooks.Open(fPath & fName)
For i = 1 To Worksheets.Count
If Worksheets(i).Visible Then
Worksheets(i).Select
Exit For
End If
Next i
FirstRowQ = MsgBox(wb.Name & vbLf & vbLf & "Is the first row the same in each worksheet?", vbYesNoCancel, "First Row Decision")
If FirstRowQ = vbYes Then
Set fRange = Application.InputBox("Please Select the First Row of the Range", "First Row Selection", Type:=8)
FR = fRange.Row
For Each ws In wb.Worksheets
With ws
If .Visible = True Then
LR = .Cells.Find("*", , , xlPart, xlByRows, xlPrevious).Row
LC = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
Set delRng = .Range(.Cells(FR, 1), .Cells(LR, LC))
delRng.Columns(1).SpecialCells(4).EntireRow.Delete
delRng.AutoFilter Field:=3, Criteria1:=Array("NE", "NW", "YH", "EM", "WM", "E", "L", "IL", "OL", "SE", "SW"), Operator:=xlFilterValues
.AutoFilter.Range.Rows.Delete
.AutoFilterMode = False
.Rows(FR).SpecialCells(4).EntireColumn.Delete 'WARNING: if a cell in a blank row is selected all columns will be deleted.
End If
End With
Next ws
ElseIf FirstRowQ = vbNo Then
For Each ws In wb.Worksheets
With ws
If .Visible = True Then
.Activate
Set fRange = Application.InputBox("Select the first row in each worksheet", "First Row Selection", Type:=8)
FR = fRange.Row
LR = .Cells.Find("*", , , xlPart, xlByRows, xlPrevious).Row
LC = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
Set delRng = .Range(.Cells(FR, 1), .Cells(LR, LC))
delRng.Columns(1).SpecialCells(4).EntireRow.Delete
delRng.AutoFilter Field:=3, Criteria1:=Array("NE", "NW", "YH", "EM", "WM", "E", "L", "IL", "OL", "SE", "SW"), Operator:=xlFilterValues
.AutoFilter.Range.Rows.Delete
.AutoFilterMode = False
.Rows(FR).SpecialCells(4).EntireColumn.Delete 'WARNING: if a cell in a blank row is selected all columns will be deleted.
End If
End With
Next ws
Else
MsgBox "You cancelled the code execution. Quitting...", vbOKOnly, "QUIT"
wb.Close SaveChanges:=False
Exit Sub
End If
wb.Close SaveChanges:=True
fName = Dir()
Loop
End Sub
PS: in some worksheets of "Removing rows n columns_S2_before.xls" workbook the column that have string criteria (NE, NW, IL, etc) is B rather than C. so the code threw an error there when testing. i inserted a column to fix it.
Originally Posted by Beatrix
----- from 'enabling the user to select the first row to start deleting rows' requirement i assume that the files are generated by some non MS office applications (or by different departments or or by different employees). so they dont have the same table structure and need to be made similar.
Reply With Quote
That's why Table 11-12-13-18-19 still have that specific rows 
