Selecting and deleting rows based on criteria

**Beatrix** · 01-16-2014, 07:31 AM

Hi Everyone ,

I need to delete blank rows in a range. This script does that.

Sub DeleteBlankRows()
    Dim r As Long
    For r = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
        If Cells(r, 1) = "" Then Rows(r).Delete
    Next r
End Sub

However there are many spreadsheets with multiple tabs and the range is dynamic in some spreadsheets. What I would like to do is to create a message box and let users answer below:

* Is first row of the range is same in each tab? If yes then let user select the first row in the first worksheet then process would apply to all worksheets. If no then let user select the first row of the range in each worksheet.

Apart from blank rows there are some certain rows need to be deleted in that range too. I will define some other certain rows like if column C has "NW", “NE”, etc then delete entire row.

Can anyone help me on this please?

Cheers

**patel** · 01-16-2014, 07:58 AM

Sub DeleteBlankRows()
    first = selection.row
    For r = Cells(Rows.Count, 1).End(xlUp).Row To first Step -1
        If Cells(r, 3) = "" or Cells(r, 3) = "NW" or Cells(r, 3) = "NE" Then Rows(r).Delete
    Next r
End Sub

**Bob Phillips** · 01-16-2014, 08:19 AM

Are all of the workbooks open, or do they need opening? Do those to be processed have a naming structure?

Do all worksheets in each workbook get processed, or just some? Do those to be processed have a naming structure?

**Beatrix** · 01-16-2014, 09:08 AM

Thanks very much for your reply xld.

Currently users open the spreadsheets and delete blank rows and columns manually. However that would be great to process all workbooks in a specific folder. So I would say they are not open and need opening. Yes, all worksheets in each workbook get processed.

Sorry didn't understand naming structure bit?

Cheers

Originally Posted by xld

Are all of the workbooks open, or do they need opening? Do those to be processed have a naming structure?

Do all worksheets in eacxh workbook get processed, or just some? Do those to be processed have a naming structure?

**Beatrix** · 01-16-2014, 09:40 AM

Sorry. I replied this but forgot to ask is it possible to delete blank columns too in the same script?

Originally Posted by xld

Are all of the workbooks open, or do they need opening? Do those to be processed have a naming structure?

Do all worksheets in eacxh workbook get processed, or just some? Do those to be processed have a naming structure?

**SamT** · 01-16-2014, 09:46 AM

Naming structure means that all workbooks have very similar names only differentiated by some unique identifiers.

Unique Date Identifier:
Daily report_140116.xls
Daily report_140117.xls

Unique Dept identifier:
Accounting 011620014.xls
Sales 01162014.xls

Unique Location Identifier:
Northeast Div.xls
Southwest Div.xls

**Beatrix** · 01-16-2014, 09:54 AM

Thank very much for explaning that SamT. Much appreciated. I knew this but didn't know it's called naming structure

In that case , there is no specific naming structure but most of the worksheets are named Table&number like Table21, Table22a, Table22b etc.

Originally Posted by SamT

Naming structure means that all workbooks have very similar names only differentiated by some unique identifiers.

Unique Date Identifier:
Daily report_140116.xls
Daily report_140117.xls

Unique Dept identifier:
Accounting 011620014.xls
Sales 01162014.xls

Unique Location Identifier:
Northeast Div.xls
Southwest Div.xls

**Beatrix** · 01-16-2014, 09:56 AM

Thanks very much for the script patel. It's not exactly what I am looking for but it does a great job too

Originally Posted by patel

Sub DeleteBlankRows()
    first = selection.row
    For r = Cells(Rows.Count, 1).End(xlUp).Row To first Step -1
        If Cells(r, 3) = "" or Cells(r, 3) = "NW" or Cells(r, 3) = "NE" Then Rows(r).Delete
    Next r
End Sub

**D_Marcel** · 01-16-2014, 05:46 PM

Beatrix, your need is a bit similar to one that I had in the last year, so I decided to use parts of the code and add some instructions to delete the rows based on your criteria. You'll need to put the code below in a new Workbook, once that the operation will happen from it to others Workbooks. Certainly the masters here would need much less lines to develop this, but I hope it helps you somehow. Let me know if works for you and if you found some error.

Note: The code will build a vertical range starting at the first selected cell and in the same For Each Next, analyse if there's cells with that values "NE", and "NW". If you, for example, select a cell in the column A, and have cells whose rows should be deleted in the column B, then you'll need to do some changes in the loop.

Good luck!

[VBA]Sub Dynamic_Delete_Rows()

'***Declarations***
Dim Sheet As Worksheet
Dim TargetPath As String
Dim Range_Selection As Range
Dim Entry, Entry2, Entry3 As Range
Dim WorkArea, WorkArea2, WorkArea3 As Range

'***Background?***
Application.ScreenUpdating = False

'***Let's find the folder where the workbooks is!***
'***Function obtained in internet***
TargetPath = GetFolder

'***Now let's list all workbooks in the current sheet***
Cells(1, 1).Value = "Workbook_Name"
ListFilesInFolder TargetPath, True

'***This will consider as range all workbooks listed previously***
Set WorkArea = ActiveSheet.Range(Cells(2, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))

'***For Each Workbook and for its Worksheets, delete rows***'
For Each Entry In WorkArea
Workbooks.Open Filename:=TargetPath & "\" & Entry.Value
Workbooks(Entry.Value).Activate
Caption = MsgBox("Is first row of the range is same in each tab?", vbYesNo, "Beatrix Automation")
If Caption = vbYes Then
Set Range_Selection = Application.InputBox("Select the first row", "Get Range", Type:=8)
For Each Sheet In ActiveWorkbook.Worksheets
Set WorkArea2 = ActiveSheet.Range(Cells(Range_Selection.Row, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
For Each Entry2 In WorkArea2
If Entry2.Value = "" Then
Entry.EntireRow.Delete
End If
Next Entry2
Set WorkArea3 = ActiveSheet.Range(Cells(1, 3), Cells(Cells(Rows.Count, 3).End(xlUp).Row, 3))
For Each Entry3 In WorkArea3
If Entry3.Value Like "*NW*" Or Entry3.Value Like "*NE*" Then
Entry3.EntireRow.Delete
End If
Next Entry3
Next Sheet

ElseIf Caption = vbNo Then
For Each Sheet In ActiveWorkbook.Worksheets
Set Range_Selection = Application.InputBox("Select the first row", "Get Range", Type:=8)
Set WorkArea2 = ActiveSheet.Range(Cells(Range_Selection.Row, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
For Each Entry2 In WorkArea2
If Entry2.Value = "" Then
Entry.EntireRow.Delete
End If
Next Entry2
Set WorkArea3 = ActiveSheet.Range(Cells(1, 3), Cells(Cells(Rows.Count, 3).End(xlUp).Row, 3))
For Each Entry3 In WorkArea3
If Entry3.Value Like "*NW*" Or Entry3.Value Like "*NE*" Then
Entry3.EntireRow.Delete
End If
Next Entry3
Next Sheet
End If
Next Entry

End Sub

Function GetFolder(Optional StartFolder As Variant = -1) As Variant

Dim GetPath As FileDialog
Dim Selection As Variant

Set GetPath = Application.FileDialog(msoFileDialogFolderPicker)

With GetPath
.Title = "Select the Directory"
.AllowMultiSelect = False
If StartFolder = -1 Then
.InitialFileName = Application.DefaultFilePath
Else
If Right(StartFolder, 1) <> "\" Then
.InitialFileName = StartFolder & "\"
Else
.InitialFileName = StartFolder
End If
End If
If .Show <> -1 Then GoTo NextCode
Selection = .SelectedItems(1)
End With
NextCode:
GetFolder = Selection
Set GetPath = Nothing

End Function

Sub ListFilesInFolder(SourceFolderName As String, IncludeSubFolders As Boolean)

Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim FileItem As Scripting.File

Set FSO = New Scripting.FileSystemObject
Set SourceFolder = FSO.GetFolder(SourceFolderName)

RowCounter = Cells(Rows.Count, 1).End(xlUp).Row + 1

'***Loop inside directory***
For Each FileItem In SourceFolder.Files
If FileItem.Name Like "*.xls" Or FileItem.Name Like "*.xlsx" Then
Cells(RowCounter, 1).Value = FileItem.Name
RowCounter = RowCounter + 1
End If
Next FileItem

'***Check if there are subfolders***
If IncludeSubFolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.Path, True
Next SubFolder
End If

'***Clean variables***
Set FSO = Nothing
Set FileItem = Nothing
Set SubFolder = Nothing
Set SourceFolder = Nothing

End Sub[/VBA]

**D_Marcel** · 01-17-2014, 05:30 AM

Beatrix, I forgot to tell that you'll need to activate Microsoft Scripting Runtime to run this code:

ScreenHunter_01 Jan. 17 10.29.jpg

Douglas Marcel

**Beatrix** · 01-20-2014, 05:18 AM

Hi Douglas ,

Thanks very much for your time. Much appreciated. I enabled Microsoft Scripting Runtime as you said but It's giving an error. Run-time error 1004 - reads:

C:\VBA\ "specific .xlsx file name which I don't know" could not be found. Check the spelling of the file name, and verify that the filr location is correct.If you are trying to open the file from your list of most recently usd files, make sure that the file has not been renamed, moved or deleted.

I created a sample folder and put there 2 xls files to test this. I've run the code and navigated to the folder after "Select the Directory" window pops up however the folder seems ok. I also converted them to the xlsx to see if it's a version issiue even your code includes both. That didn't work either. Any other suggestions I can change and test?

Originally Posted by D_Marcel

Beatrix, I forgot to tell that you'll need to activate Microsoft Scripting Runtime to run this code:

ScreenHunter_01 Jan. 17 10.29.jpg

Douglas Marcel

**Beatrix** · 01-20-2014, 05:21 AM

Sorry! In my previous reply: it should read the folder seems "empty" not "ok"

**mancubus** · 01-20-2014, 01:47 PM

hi Beatrix.

try this.

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
    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 \
    fName = Dir(fPath & "*.xls*")
    Do While fName <> ""
        Set wb = Workbooks.Open(fPath & fName)
        wb.Worksheets(1).Activate
        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
                    LR = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
                    LC = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
                    If LR > FR Then 'ws has row(s) with data below selected first row
                        For i = LR To FR Step -1
                            If .Cells(i, 1) = "" Then .Rows(i).Delete 'check for blank cells in Col A
                            'or: delete above line and use below line if only blank rows will be deleted
                            'If Application.CountA(Rows(i)) = 0 Then .Rows(i).Delete 'check if whole row is blank
                            If .Cells(i, 3) = "NW" Or .Cells(i, 3) = "NE" Then .Rows(i).Delete 'check for specific values in Col C
                        Next i
                    End If
                    If LC > 1 Then 'ws has more than 1 columns with data
                        For i = LC To 1 Step -1
                            If Application.CountA(Columns(i)) = 0 Then .Columns(i).Delete 'check if whole column is blank
                        Next i
                    End If
                End With
            Next ws
        ElseIf FirstRowQ = vbNo Then
            For Each ws In wb.Worksheets
                With ws
                    .Activate
                    Set fRange = Application.InputBox("Select the first row in each worksheet", "First Row Selection", Type:=8)
                    FR = fRange.Row
                    LR = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
                    LC = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
                    If LR > FR Then 'ws has row(s) with data below selected first row
                        For i = LR To FR Step -1
                            If .Cells(i, 1) = "" Then .Rows(i).Delete 'check for blank cells in Col A
                            'or: delete above line and use below line if only blank rows will be deleted
                            'If Application.CountA(Rows(i)) = 0 Then .Rows(i).Delete 'check if whole row is blank
                            If .Cells(i, 3) = "NW" Or .Cells(i, 3) = "NE" Then .Rows(i).Delete 'check for specific values in Col C
                        Next i
                    End If
                    If LC > 1 Then 'ws has more than 1 columns with data
                        For i = LC To 1 Step -1
                            If Application.CountA(Columns(i)) = 0 Then .Columns(i).Delete 'check if whole column is blank
                        Next i
                    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

**D_Marcel** · 01-20-2014, 03:25 PM

Good code mancubus!

Beatrix, sorry for the errors but I tested here by creating a folder with dummy files with extension ".xlsx" inside, and no errors happened. In wich line the error 1004 occurs?
During testing, I found an error in the code:

[VBA] '***For Each Workbook and for its Worksheets, delete rows***'
For Each Entry In WorkArea
Workbooks.Open Filename:=TargetPath & "\" & Entry.Value
Workbooks(Entry.Value).Activate
Caption = MsgBox("Is first row of the range is same in each tab?", vbYesNo, "Beatrix Automation")
If Caption = vbYes Then
Set Range_Selection = Application.InputBox("Select the first row", "Get Range", Type:=8)
For Each Sheet In ActiveWorkbook.Worksheets
Set WorkArea2 = ActiveSheet.Range(Cells(Range_Selection.Row, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
For Each Entry2 In WorkArea2
If Entry2.Value = "" Then
Entry.EntireRow.Delete[/VBA]

The last line should be Entry2.EntireRow.Delete

Same to this:

[VBA]ElseIf Caption = vbNo Then For Each Sheet In ActiveWorkbook.Worksheets
Set Range_Selection = Application.InputBox("Select the first row", "Get Range", Type:=8)
Set WorkArea2 = ActiveSheet.Range(Cells(Range_Selection.Row, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
For Each Entry2 In WorkArea2
If Entry2.Value = "" Then
Entry.EntireRow.Delete[/VBA]

**mancubus** · 01-21-2014, 01:00 AM

Originally Posted by D_Marcel

Good code mancubus!

thanks Marcel. yours is too. the OP states "process all workbooks in a specific folder" so i used a variable for that specific folder. but if it changes, it will be a good practice to enable user to browse for folder containing the files to be processed. using LIKE operator for "partial matches" is also a good idea for row deletion. i assumed it's a full match.

**snb** · 01-21-2014, 02:11 AM

To return to the start of your question:

Sub M_snb()
  for each sh in sheets
     sh.columns(1).specialcells(4).entirerow.delete
     sh.rows(1).specialcells(4).entirecolumn.delete
  next
End Sub

The criterion for deleting a row/column is the emptiness of a cell in columnA / resp. in row 1.
To include your other requirements:
If all 'xlsx' files reside in folder "G:\OF\"

Sub M_snb()
  sn=split(createobject("wscript.shell").exec("cmd /c dir ""G:\OF\*.xlsx"" /b").stdout.readall,vbcrlf)

  for j=0 to ubound(sn)
    with getobject(sn(j))
      for each sh in .sheets
        sh.columns(1).specialcells(4).entirerow.delete
        sh.rows(1).specialcells(4).entirecolumn.delete
     next
     .close -1
   end with
  next
End Sub

**Beatrix** · 01-21-2014, 07:54 AM

Hi All ,

Thanks very much for all replies. Much appreciated. I keep having errors. It might be me or data structure or the codes. The best solution is attaching the sample files to see where it goes wrong in each code. There is a lot to change in my files because of the data protection. I'll attach samples as soon as I can.

Cheers
B.

**D_Marcel** · 01-21-2014, 08:36 AM

Hi Beatrix,

Please, do this. Attach the folder with the Workbooks (with dummy data, if possible) in a .ZIP file.

Douglas

**snb** · 01-21-2014, 09:51 AM

If anything is protected don't be surprised.
Remove any protection before code testing.

**Beatrix** · 01-21-2014, 10:01 AM

Sorry I guess It's me,my English etc.. couldn't explain it properly. I meant data security policies, compliance policy etc.. I need to change my data but keep the structure as it is..

Originally Posted by snb

If anything is protected don't be surprised.
Remove any protection before code testing.

Thread: Selecting and deleting rows based on criteria

Thread Tools

Display

Selecting and deleting rows based on criteria

Posting Permissions