Few more Adjusments Wanted

[Plukey]

Below, Once the button is activated...it searches for "Y" in "A2:A" in all worksheets specified. It means that line is closed... Someone will enter a Y for yes Its Closed and transfer to Sheet "Closed PS" (This Person is not familiar with PC concepts) So we have to be gentle . A quick report is given ..Who - how many / & who -doesn't. I would like it to delete the original source and prompt within the preview box (Yes/Transfer & Delete) - (No Exit), basically... I can change the verbiage if need be. Currently, it just gives the preview and I have to delete original source manually.
I made it a button because they would get overwhelmed if It happened instantly with SheetChanged ..Advise welcomed please!

Option Explicit
Sub SearchForString()
    Dim FirstAddress As String, WhatFor As String
    Dim Cell As Range, Sheet As Worksheet
    Dim sSheetsWithData As String, sSheetsWithoutData As String
    Dim lSheetRowsCopied As Long, lAllRowsCopied As Long
    Dim bFound As Boolean
    Dim sOutput As String
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .CutCopyMode = False
    End With
    
    WhatFor = ("Y") <<<'I used to have a msg box..but decided not to, because it will always be Y'<<<
    If WhatFor = Empty Then Exit Sub
    
    For Each Sheet In Sheets
        If Sheet.Name <> "HOMEPAGE" And Sheet.Name <> "Other" And Sheet.Name <> "Closed PS" And Sheet.Name <> "Backlog to Research" And Sheet.Name <> "Pre-Scrap" Then
            bFound = False
            With Sheet.Columns(1)
                Set Cell = .Find(WhatFor, LookIn:=xlValues, LookAt:=xlWhole)
                If Not Cell Is Nothing Then
                    bFound = True
                    lSheetRowsCopied = 0
                    FirstAddress = Cell.Address
                    Do
                        lSheetRowsCopied = lSheetRowsCopied + 1
                        Cell.EntireRow.Copy Destination:=Sheets("Closed PS").Range("A" & rows.Count).End(xlUp).Offset(1, 0)
                        Set Cell = .FindNext(Cell)
                    Loop Until Cell Is Nothing Or Cell.Address = FirstAddress
                Else
                    bFound = False
                End If
                If bFound Then
                    sSheetsWithData = sSheetsWithData & "    " & Sheet.Name & " (" & lSheetRowsCopied & ")" & vbLf
                    lAllRowsCopied = lAllRowsCopied + lSheetRowsCopied
                Else
                    sSheetsWithoutData = sSheetsWithoutData & "    " & Sheet.Name & vbLf
                End If
            End With
        End If
    Next Sheet
    
    If sSheetsWithData <> vbNullString Then
        sOutput = "Sheets with data (rows copied)" & vbLf & vbLf & sSheetsWithData & vbLf & _
            "Total rows copied = " & lAllRowsCopied & vbLf & vbLf
    Else
        sOutput = "No sheeTs contained data to be copied" & vbLf & vbLf
    End If
    
    If sSheetsWithoutData <> vbNullString Then
        sOutput = sOutput & "Sheets with no rows copied:" & vbLf & vbLf & sSheetsWithoutData
    Else
        sOutput = sOutput & "All sheets had data that was copied."
    End If
    
    If sOutput <> vbNullString Then MsgBox sOutput, , "Copy Report"
    
    With Worksheets("Closed PS")
        If .Cells(1, 1).Value = vbNullString Then .rows(1).Delete
    End With
    Application.EnableEvents = True
    
    Set Cell = Nothing
    
    
End Sub

 

[Plukey]

I have some cells in between that are empty..once I fill in a group of cells without blanks, itll copy paste & delete until it comes to a sheet with blank cells. then throws the 400 error...

 

[Plukey]

I have some cells in between that are empty..once I fill in a group of cells without blanks, itll copy paste & delete until it comes to a sheet with blank cells. then throws the 400 error...

Also, the code stops at the .Delete line if there are blank cells in between. If there aren’t empty cells it works perfectly.

 

[DanteAmor]

It's strange, maybe they're not "blank", maybe they're characters that look like spaces.
You can fix your sheet to remove those "blank".

 

[Plukey]

Yes, I didn’t think about that. I’ll trim the columns and let you know.

 

[Plukey]

I ran a trim on column A and still getting stuck on first sheet .
If I remove that line it works...but of Corse with out deleting

rdel.EntireRow.Delete

 

[DanteAmor]

I would have to review the data on your sheet.

You could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. If the workbook contains confidential information, you could replace it with generic data.

Do you have merged cells?

 

[Plukey]

https://www.dropbox.com/s/myjt33nhpvgq44r/SampleTest1.xlsx?dl=0

 

[Plukey]

After playing around and converting all the sheets from table to range, it works. How can I keep the tables and still use?

 

[DanteAmor]

That's the problem of using tables, you have to fix the code to work with tables.


If you are going to use the data as a database, it is advisable not to use tables, the tables are excellent for presentations, reports and data management only in the table, but to give you database treatment, better as a range.

 

[Plukey]

I would like to keep the tables, how could we change code to work? Just to have options...