Delete rows based on cell value - multiple sheets

[keaveneydan]

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?

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

 

[Sektor]

If you're interested in boosting the speed, I can tell you the principle how to do it.

 

[keaveneydan]

Yes please

Have tried this but it seems to stay on the same sheet and ends up deleting all rows....except row 1

    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
                Range("Y1").AutoFilter Field:=1, Criteria1:="Option/Cash"
                Application.DisplayAlerts = False
                ActiveSheet.UsedRange.Offset(1, 0).Resize(ActiveSheet.UsedRange.Rows.Count - 1).Rows.Delete
                ActiveSheet.ShowAllData
                Application.DisplayAlerts = True
        End If
    Next ws