Delete rows based on cell value - multiple sheets

K

keaveneydan

Board Regular
Joined
Apr 29, 2014
Messages
144
I want to delete rows based on the value in Column Y for a number of sheets but cannot get it to work. It works for my first sheet but not the remaining 6. Originally I had it done as an array of sheets, then changed it to doing each individually and finally put it in new macros and access through a Call. But still it won't work.

Any ideas?

Code: 
Sub ConsolidateDataUsingFileList()
'--Purpose is open each file specified in sheet Info, then copy
'    that file's data and append it to the dataset
'    on sheet Portfolio of this workbook
'--code does not include validation that referenced sheets exist
 Dim lLastRowInfo As Long, lLastRowSource As Long, lNdx As Long
 Dim sFilepath As String, sSheetname As String, dSheetname As String, sFilename As String
 Dim vInfoData As Variant
 Dim wkbSource As Workbook
 Dim wksTarget As Worksheet
 Dim Wb As Workbook
 Set Wb = ThisWorkbook
Application.ScreenUpdating = False
Worksheets(Array("NGUF PERF", "SCPF PERF", "SEEF PERF", "SEJF PERF", "SEVF PERF", "SMART PERF", "SMVF PERF", "NGUF VAR", "SCPF VAR", "SEEF VAR", "SEJF VAR", "SEVF VAR", "SMART VAR", "SMVF PERF")).Select
Range("A:V").Select
Selection.ClearContents
 
 '--read filelist data from sheet Info into array
 With ThisWorkbook.Sheets("Reference")
   lLastRowInfo = .Cells(.Rows.Count, "D").End(xlUp).Row
   If lLastRowInfo < 2 Then
      MsgBox "No data found in Column D of Sheet Info"
      GoTo ExitProc
   End If
   vInfoData = .Range("D2:G" & lLastRowInfo).Value
 End With

For lNdx = 1 To UBound(vInfoData, 1)
    sFilepath = vInfoData(lNdx, 1)
    sSheetname = vInfoData(lNdx, 2)
    dSheetname = vInfoData(lNdx, 3)
    sFilename = vInfoData(lNdx, 4)
   '--attempt to open specified workbook
   On Error Resume Next
   Set wkbSource = Workbooks.Open(Filename:=sFilepath, _
      UpdateLinks:=False)
   On Error GoTo 0
   
   If LCase$(ActiveWorkbook.FullName) <> LCase$(sFilepath) Then
      MsgBox sFilepath & " valuation file not found." & vbCr _
         & "Please save in directory and start macro again"
      GoTo ExitProc
   Else '--file successfully opened
Application.Workbooks.Open (sFilepath), ReadOnly:=False, UpdateLinks:=False
Sheets(sSheetname).Select
Dim Lastrow As Integer
Lastrow = ActiveSheet.UsedRange.Rows.Count
Range("a6:V" & Lastrow - 4).Select
Selection.Copy
ThisWorkbook.Activate
Sheets(dSheetname).Select
Range("A1").Select
ActiveSheet.Paste
Selection.UnMerge
Columns("A:A").Select
    Selection.Replace What:=">", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
Windows(sFilename).Activate
ActiveWindow.Close
   End If
 Next lNdx
 

Worksheets(Array("NGUF PERF", "SCPF PERF", "SEEF PERF", "SEJF PERF", "SEVF PERF", "SMART PERF", "SMVF PERF")).Select
Range("Y1").Select
Selection.AutoFill Destination:=Range("Y1:Y250"), Type:=xlFillDefault
    
Call CleanNGUF
Call CleanSCPF
    
    Sheets("SEEF PERF").Select
    With ActiveSheet
        .DisplayPageBreaks = False
        Firstrow = 1
        LastrowFilter = 250
        For Lrow = Lastrow To Firstrow Step -1
            With .Cells(Lrow, "Y")
                If Not IsError(.Value) Then
                    If .Value <> "0" Then .EntireRow.Delete
                End If
            End With
        Next Lrow
    End With
    
    Sheets("SEJF PERF").Select
    With ActiveSheet
        .DisplayPageBreaks = False
        Firstrow = 1
        LastrowFilter = 250
        For Lrow = Lastrow To Firstrow Step -1
            With .Cells(Lrow, "Y")
                If Not IsError(.Value) Then
                    If .Value <> "0" Then .EntireRow.Delete
                End If
            End With
        Next Lrow
    End With
   
    Sheets("SEVF PERF").Select
    With ActiveSheet
        .DisplayPageBreaks = False
        Firstrow = 1
        LastrowFilter = 250
        For Lrow = Lastrow To Firstrow Step -1
            With .Cells(Lrow, "Y")
                If Not IsError(.Value) Then
                    If .Value <> "0" Then .EntireRow.Delete
                End If
            End With
        Next Lrow
    End With
   
    Sheets("SMART PERF").Select
    With ActiveSheet
        .DisplayPageBreaks = False
        Firstrow = 1
        LastrowFilter = 250
        For Lrow = Lastrow To Firstrow Step -1
            With .Cells(Lrow, "Y")
                If Not IsError(.Value) Then
                    If .Value <> "0" Then .EntireRow.Delete
                End If
            End With
        Next Lrow
    End With
    
    Sheets("SMVF PERF").Select
    With ActiveSheet
        .DisplayPageBreaks = False
        Firstrow = 1
        LastrowFilter = 250
        For Lrow = Lastrow To Firstrow Step -1
            With .Cells(Lrow, "Y")
                If Not IsError(.Value) Then
                    If .Value <> "0" Then .EntireRow.Delete
                End If
            End With
        Next Lrow
    End With
    
MsgBox "Data Updated"
Sheets("NGUF").Select
ExitProc:
 Application.ScreenUpdating = True
End Sub
 
Sub CleanNGUF()
Dim Firstrow As Long
Dim LastrowFilter As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
    Sheets("NGUF PERF").Select
    With ActiveSheet
        'Turn off Page Breaks, we do this for speed
        .DisplayPageBreaks = False
        'Set the first and last row to loop through
        Firstrow = 1
        LastrowFilter = 250
        'We loop from Lastrow to Firstrow (bottom to top)
        For Lrow = Lastrow To Firstrow Step -1
            'We check the values in the A column in this example
            With .Cells(Lrow, "Y")
                If Not IsError(.Value) Then
                    If .Value <> "0" Then .EntireRow.Delete
                    'This will delete each row with the Value "ron"
                    'in Column A, case sensitive.
                End If
            End With
        Next Lrow
    End With
End Sub
Sub CleanSCPF()
Dim Firstrow As Long
Dim LastrowFilter As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
    Sheets("SCPF PERF").Select
    With ActiveSheet
        'Turn off Page Breaks, we do this for speed
        .DisplayPageBreaks = False
        'Set the first and last row to loop through
        Firstrow = 1
        LastrowFilter = 250
        'We loop from Lastrow to Firstrow (bottom to top)
        For Lrow = Lastrow To Firstrow Step -1
            'We check the values in the A column in this example
            With .Cells(Lrow, "Y")
                If Not IsError(.Value) Then
                    If .Value <> "0" Then .EntireRow.Delete
                    'This will delete each row with the Value "ron"
                    'in Column A, case sensitive.
                End If
            End With
        Next Lrow
    End With
End Sub
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Sort by date Sort by votes
You need to create array with sheet names and loop thru it. Also, the fastest method to remove is to use AutoFilter.
 
Upvote 0
Try this:

Code: 
Option Explicit


Sub delrows()
Dim ws As Worksheet
Dim lr As Long
Dim i As Long


Application.ScreenUpdating = False
For Each ws In Worksheets
lr = ws.Range("Y" & Rows.Count).End(xlUp).Row
    For i = lr To 1 Step -1
    If ws.Range("Y" & i) <> 0 Then
    ws.Range("Y" & i).EntireRow.Delete
    End If
    Next i
Next ws
Application.ScreenUpdating = True
MsgBox "complete"


End Sub
 
Upvote 0
Thanks for responses


I don't want to do for each sheet, only those with "Perf" in the Sheetname

So have tried the below but get Compile Error: Next without For


Code: 
Dim ws As Worksheet
Dim lr As Long
Dim i As Long
For Each ws In Worksheets
If wks.Name <> "*Perf*" Then
lr = ws.Range("Y" & Rows.Count).End(xlUp).Row
    For i = lr To 1 Step -1
    If ws.Range("Y" & i) <> 0 Then
    ws.Range("Y" & i).EntireRow.Delete
    End If
    Next i
Next ws
 
Upvote 0
Code: 
Sub F()

    Dim ws As Worksheet
    Dim lr As Long
    Dim i As Long
    
    For Each ws In Worksheets
        If wks.Name Like "*Perf*" Then
            lr = ws.Range("Y" & Rows.Count).End(xlUp).Row
            For i = lr To 1 Step -1
                If ws.Range("Y" & i) <> 0 Then ws.Range("Y" & i).EntireRow.Delete
            Next i
        End If
    Next ws

End Sub
 
Last edited:
Upvote 0
Thanks Sektor but still get Compile Error: Next without For

Have also tried your original suggestion of creating an array but cannot get MyArray =

Code: 
Dim ws As Worksheet
Dim lr As Long
Dim i As Long
Dim MyArray As Object
'For Each ws In Worksheets
'If wks.Name <> "*Perf*" Then
MyArray = ThisWorkbook.Sheets(Array("NGUF PERF", "SCPF PERF", "SEEF PERF", "SEJF PERF", "SEVF PERF", "SMART PERF", "SMVF PERF"))
For Each ws In MyArray
lr = ws.Range("Y" & Rows.Count).End(xlUp).Row
    For i = lr To 1 Step -1
    If ws.Range("Y" & i) <> 0 Then
    ws.Range("Y" & i).EntireRow.Delete
    End If
    Next i
Next ws
 
Upvote 0
This code works - double checked it.
Code: 
Sub F()

    Dim ws As Worksheet
    Dim lr As Long
    Dim i As Long
    
    For Each ws In Worksheets
        If ws.Name Like "*Perf*" Then
            lr = ws.Range("Y" & ws.Rows.Count).End(xlUp).Row
            For i = lr To 1 Step -1
                If ws.Range("Y" & i) <> 0 Then ws.Range("Y" & i).EntireRow.Delete
            Next i
        End If
    Next ws

End Sub
 
Upvote 0
Cool, takes a long time (60 secs) but does what I want

Thanks very much

Code: 
Sub ConsolidateDataUsingFileList()
'--Purpose is open each file specified in sheet Info, then copy
'    that file's data and append it to the dataset
'    on sheet Portfolio of this workbook
'--code does not include validation that referenced sheets exist
 Dim lLastRowInfo As Long, lLastRowSource As Long, lNdx As Long
 Dim sFilepath As String, sSheetname As String, dSheetname As String, sFilename As String
 Dim vInfoData As Variant
 Dim wkbSource As Workbook
 Dim wksTarget As Worksheet
 Dim Wb As Workbook
 Set Wb = ThisWorkbook
Application.ScreenUpdating = False
Worksheets(Array("NGUF PERF", "SCPF PERF", "SEEF PERF", "SEJF PERF", "SEVF PERF", "SMART PERF", "SMVF PERF", "NGUF VAR", "SCPF VAR", "SEEF VAR", "SEJF VAR", "SEVF VAR", "SMART VAR", "SMVF PERF")).Select
Range("A:V").Select
Selection.ClearContents
 
 '--read filelist data from sheet Info into array
 With ThisWorkbook.Sheets("Reference")
   lLastRowInfo = .Cells(.Rows.Count, "D").End(xlUp).Row
   If lLastRowInfo < 2 Then
      MsgBox "No data found in Column D of Sheet Info"
      GoTo ExitProc
   End If
   vInfoData = .Range("D2:G" & lLastRowInfo).Value
 End With

For lNdx = 1 To UBound(vInfoData, 1)
    sFilepath = vInfoData(lNdx, 1)
    sSheetname = vInfoData(lNdx, 2)
    dSheetname = vInfoData(lNdx, 3)
    sFilename = vInfoData(lNdx, 4)
   '--attempt to open specified workbook
   On Error Resume Next
   Set wkbSource = Workbooks.Open(Filename:=sFilepath, _
      UpdateLinks:=False)
   On Error GoTo 0
   
   If LCase$(ActiveWorkbook.FullName) <> LCase$(sFilepath) Then
      MsgBox sFilepath & " valuation file not found." & vbCr _
         & "Please save in directory and start macro again"
      GoTo ExitProc
   Else '--file successfully opened
Application.Workbooks.Open (sFilepath), ReadOnly:=False, UpdateLinks:=False
Sheets(sSheetname).Select
Dim Lastrow As Integer
Lastrow = ActiveSheet.UsedRange.Rows.Count
Range("a6:V" & Lastrow - 4).Select
Selection.Copy
ThisWorkbook.Activate
Sheets(dSheetname).Select
Range("A1").Select
ActiveSheet.Paste
Selection.UnMerge
Columns("A:A").Select
    Selection.Replace What:=">", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
Windows(sFilename).Activate
ActiveWindow.Close
   End If
 Next lNdx
 

Worksheets(Array("NGUF PERF", "SCPF PERF", "SEEF PERF", "SEJF PERF", "SEVF PERF", "SMART PERF", "SMVF PERF")).Select
Range("Y1").Select
Selection.AutoFill Destination:=Range("Y1:Y250"), Type:=xlFillDefault
    
    Dim ws As Worksheet
    Dim lr As Long
    Dim i As Long
    
    For Each ws In Worksheets
        If ws.Name Like "*PERF*" Then
            lr = ws.Range("Y" & Rows.Count).End(xlUp).Row
            For i = lr To 1 Step -1
                If ws.Range("Y" & i) <> 0 Then ws.Range("Y" & i).EntireRow.Delete
            Next i
        End If
    Next ws

    
MsgBox "Data Updated"
Sheets("NGUF").Select
ExitProc:
 Application.ScreenUpdating = True
End Sub
 
Upvote 0
The faster would be to use AutoFilter.
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Solved
Trying to Delete row
Replies
4
Views
265
Georgiboy
Georgiboy
S
  • Solved
For each row, create new folder based on single cell value, then save exported XML doc to matching folder.
Replies
3
Views
218
shand
S
E
  • Question
This code is trying to delete all times from cells so just show`s Date
2
Replies
17
Views
514
Joe4
Joe4
E
  • Question
Need to get first 2 Values of a Workbook Name
Replies
3
Views
296
Georgiboy
Georgiboy
E
  • Solved
Macro to run anytime a ActiveX checkbox is used (no linked cells)
Replies
8
Views
392
John_w
J

Forum statistics

Threads
1,215,575
Messages
6,125,631
Members
449,241
Latest member
NoniJ

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top