Help required - User input for text search and delete remaining rows

**ssss2005** · 08-18-2015, 03:07 AM

Hello,

First post and very much a noob, so please go easy on me.

Initially my idea was to have the user enter a text search term via an input box and for this term to be highlighted blue and all other rows (not containing the search term) to be deleted/removed.

I have searched and searched for the answer but come up with no joy

So I have botched this crazy work around (See code below) using the interior cell colours to indicate which rows require deleting. This strange method does work, except for when the user enters a search term that is NOT contained within the data, all rows (because they are white!) are deleted. Can I somehow add msgbox to intervene if the search term isn't found? I've tried to do this but unfortunately with no success. Or failing that can someone come up with a bit of smart code to do exactly what I originally required - Search worksheet based on user input, highlight matches, delete all other rows that do not contain a match.

Hopefully you wonderful people can help.

Sub DeleteRows()

    Dim SrchStr, Prompt, Title As String
    Dim rCell As Range
    Dim x As Long
    Dim y As Long
    Dim rngTempb As Range
    Dim LastRow As Long
    Dim i As Long
     
    Application.ScreenUpdating = False
     
    
startSearch1:
    Title = "Please enter Search Term?"
    SrchStr = Application.InputBox(Prompt, Title, "")
    
    If SrchStr = False Then Exit Sub
'Force valid entry
     If SrchStr = "" Then
       If MsgBox("The Search Field Can Not Be Left Blank" _
       & vbLf & vbLf & "Do You Want To Try Again?", vbYesNo + vbQuestion, "...") = _
                        vbNo Then Exit Sub
          GoTo startSearch1
     End If
    
    Set rngTempb = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
If Not rngTempb Is Nothing Then
    Range(Cells(1, 1), rngTempb).Select
End If
    
    y = Len(SrchStr)
 For Each rCell In Selection
     x = 1
     Do
       x = InStr(x, UCase(rCell.Value), UCase(SrchStr))
       If x > 0 Then
           rCell.Characters(x, y).Font.Color = vbBlue
           rCell.Characters(x, y).Font.Bold = True
           rCell.EntireRow.Interior.Color = RGB(255, 255, 254)
           x = x + 1
            End If
     Loop Until x = 0
 Next rCell
    
    LastRow = ActiveSheet.UsedRange.Rows.Count + ActiveSheet.UsedRange.Rows(1).Row - 1
    
    For i = LastRow To 2 Step -1
        If Cells(i, "A").Interior.Color = RGB(255, 255, 255) Or Cells(i, "A").Interior.Color = RGB(218, 150, 148) Then
            Rows(i).Delete
        End If
    Next i
    
    
  Application.ScreenUpdating = True
       
End Sub

**Greg M** · 08-18-2015, 08:01 PM

Hi there,

Try the following code and see if it does what you want:



Option Explicit


'=========================================================================================
'=========================================================================================


Sub DeleteRows()

    Const iFIRST_ROW    As Integer = 2

    Dim rRangeToSearch  As Range
    Dim rRowToSearch    As Range
    Dim rSearchCell     As Range
    Dim bDeleteRow      As Boolean
    Dim rLastRow        As Range
    Dim vSearch         As Variant
    Dim sSearch         As String
    Dim sTitle          As String
    Dim iYesNo          As Integer
    Dim lRowNo          As Long
    Dim wks             As Worksheet

    Do

        sTitle = "Please enter Search Term?"
        vSearch = Application.InputBox("", sTitle)

        If vSearch = vbNullString Then

            iYesNo = MsgBox("The Search Field Can Not Be Left Blank" & _
                             vbLf & vbLf & _
                            "Do You Want To Try Again?", vbYesNo + vbQuestion)

            If iYesNo = vbYes Then
                vSearch = True
            End If

        End If

    Loop Until vSearch <> True

'   Continue only if a valid value has been entered for the search string
    If vSearch <> vbNullString And _
       vSearch <> False Then

'       Convert the (Variant) search string value to a String variable
        sSearch = CStr(vSearch)

        Set wks = ActiveSheet

'       Restrict the range of the search operation to the UsedRange of the worksheet
        Set rRangeToSearch = wks.UsedRange

'       Define the Range on the worksheet to search
        With rRangeToSearch
            Set rLastRow = .Rows(.Rows.Count)
        End With

'       Scan through each row, from the bottom upwards - Important!
        For lRowNo = rLastRow.Row To iFIRST_ROW Step -1

            Set rRowToSearch = rRangeToSearch.Rows(lRowNo)

            bDeleteRow = True

'           Check whether ANY cell in the row contains the search text
            With rRowToSearch
                Set rSearchCell = .Cells.Find(What:=sSearch)
            End With

'           If the search was successful then scan through each cell in the row
            If Not rSearchCell Is Nothing Then

                Call ScanEachCell(rRowToSearch:=rRowToSearch, sSearch:=sSearch)

'               The search string has been located in one or more cells in the row,
'               so the row should not be deleted
                bDeleteRow = False

            End If

'           Delete the entire row if appropriate
            If bDeleteRow = True Then
                rRowToSearch.EntireRow.Delete
            End If

        Next lRowNo

    End If

End Sub


'=========================================================================================
'=========================================================================================


Private Sub ScanEachCell(rRowToSearch As Range, sSearch As String)

    Dim rCell As Range

    For Each rCell In rRowToSearch.Cells

'       Proceed only if the cell does not contain a Null value
        If rCell.Value <> vbNullString Then

            If InStr(1, rCell.Value, sSearch, vbTextCompare) <> 0 Then
                Call HighlightSearchCharacters(rCell:=rCell, sSearch:=sSearch)
            End If

        End If

    Next rCell

End Sub


'=========================================================================================
'=========================================================================================


Private Sub HighlightSearchCharacters(rCell As Range, sSearch As String)

    Dim iNoOfCharacters As Integer
    Dim iCharacterNo    As Integer

    iNoOfCharacters = Len(sSearch)
    iCharacterNo = 1

    Do

        iCharacterNo = InStr(iCharacterNo, rCell.Value, sSearch, vbTextCompare)

        If iCharacterNo > 0 Then
            rCell.Characters(iCharacterNo, iNoOfCharacters).Font.Color = vbBlue
            rCell.Characters(iCharacterNo, iNoOfCharacters).Font.Bold = True
        iCharacterNo = iCharacterNo + 1
        End If

    Loop Until iCharacterNo = 0

End Sub

Hope this helps - please let me know how you get on.

Regards,

Greg M

**ssss2005** · 08-19-2015, 03:25 AM

Is it possible I can stop it deleting any rows if the search term is not found at all?

**ssss2005** · 08-19-2015, 03:17 AM

Hello Greg,

Firstly let me say a very big thank you for taking the time to look at this and for coming up with some superb code, with excellent explanatory annotations - Thank you! (this is a huge help in my own learning)

It's certainly far better than my effort BUT, unfortunately it also seems to suffer from the same problem as mine whereby if a text term is entered that is not found, it still deletes all the rows

Does this happen when you run it? As I can see you have built in some error handling if the term is not found, but for some reason this doesn't appear to be working.

Again many thanks for getting me this far

**skywriter** · 08-19-2015, 03:29 AM

Can you post a sample sheet with some good data in it and tell us which rows you would delete and which would be left based on a search term that you specify.

Attach a sample workbook. Make sure there is just enough data to demonstrate your need. Include a BEFORE sheet and an AFTER sheet in the workbook if needed to show the process you're trying to complete or automate. Make sure your desired results are shown, mock them up manually if necessary.
Remember to desensitize the data.

ViewPic

**Greg M** · 08-19-2015, 05:08 AM

Hi again,

Sorry - idiot here - that's the bit I forgot to include

Try the following version and see if it works for you:



Option Explicit


'=========================================================================================
'=========================================================================================


Sub DeleteRows()

    Const iFIRST_ROW    As Integer = 2

    Dim rRangeToSearch  As Range
    Dim rRowToSearch    As Range
    Dim rSearchCell     As Range
    Dim bDeleteRow      As Boolean
    Dim rLastRow        As Range
    Dim vSearch         As Variant
    Dim sSearch         As String
    Dim sTitle          As String
    Dim iYesNo          As Integer
    Dim lRowNo          As Long
    Dim wks             As Worksheet

    Do

        sTitle = "Please enter Search Term?"
        vSearch = Application.InputBox("", sTitle)

        If vSearch = vbNullString Then

            iYesNo = MsgBox("The Search Field Can Not Be Left Blank" & _
                             vbLf & vbLf & _
                            "Do You Want To Try Again?", vbYesNo + vbQuestion)

            If iYesNo = vbYes Then
                vSearch = True
            End If

        End If

    Loop Until vSearch <> True

'   Continue only if a valid value has been entered for the search string
    If vSearch <> vbNullString And _
       vSearch <> False Then

'       Convert the (Variant) search string value to a String variable
        sSearch = CStr(vSearch)

        Set wks = ActiveSheet

'       Restrict the range of the search operation to the UsedRange of the worksheet
        Set rRangeToSearch = wks.UsedRange

'       Define the Range on the worksheet to search
        With rRangeToSearch
            Set rLastRow = .Rows(.Rows.Count)
        End With

'       Check whether or not the search text appears anywhere on the worksheet
        With rRangeToSearch
            Set rSearchCell = .Cells.Find(What:=sSearch)
        End With

'       Continue only if at least one instance of the search text has been located
        If Not rSearchCell Is Nothing Then

'             Scan through each row, from the bottom upwards - Important!
              For lRowNo = rLastRow.Row To iFIRST_ROW Step -1

                  Set rRowToSearch = rRangeToSearch.Rows(lRowNo)

                  bDeleteRow = True

'                 Check whether ANY cell in the row contains the search text
                  With rRowToSearch
                      Set rSearchCell = .Cells.Find(What:=sSearch)
                  End With

'                 If the search was successful then scan through each cell in the row
                  If Not rSearchCell Is Nothing Then

                      Call ScanEachCell(rRowToSearch:=rRowToSearch, sSearch:=sSearch)

'                     The search string has been located in one or more cells in the row,
'                     so the row should not be deleted
                      bDeleteRow = False

                  End If

'                 Delete the entire row if appropriate
                  If bDeleteRow = True Then
                      rRowToSearch.EntireRow.Delete
                  End If

            Next lRowNo

        Else: MsgBox "The string """ & sSearch & """ cannot be located", vbInformation

        End If

    End If

End Sub


'=========================================================================================
'=========================================================================================


Private Sub ScanEachCell(rRowToSearch As Range, sSearch As String)

    Dim rCell As Range

    For Each rCell In rRowToSearch.Cells

'       Proceed only if the cell does not contain a Null value
        If rCell.Value <> vbNullString Then

            If InStr(1, rCell.Value, sSearch, vbTextCompare) <> 0 Then
                Call HighlightSearchCharacters(rCell:=rCell, sSearch:=sSearch)
            End If

        End If

    Next rCell

End Sub


'=========================================================================================
'=========================================================================================


Private Sub HighlightSearchCharacters(rCell As Range, sSearch As String)

    Dim iNoOfCharacters As Integer
    Dim iCharacterNo    As Integer

    iNoOfCharacters = Len(sSearch)
    iCharacterNo = 1

    Do

        iCharacterNo = InStr(iCharacterNo, rCell.Value, sSearch, vbTextCompare)

        If iCharacterNo > 0 Then
            rCell.Characters(iCharacterNo, iNoOfCharacters).Font.Color = vbBlue
            rCell.Characters(iCharacterNo, iNoOfCharacters).Font.Bold = True
        iCharacterNo = iCharacterNo + 1
        End If

    Loop Until iCharacterNo = 0

End Sub

As before, please let me know how you get on.

Regards,

Greg M

**Greg M** · 08-19-2015, 05:22 AM

Hi again,

The following version of the input loop is just a little bit more elegant than the previous one:



    Do

        sTitle = "Please enter Search Term?"
        vSearch = Application.InputBox("", sTitle)

        If vSearch = vbNullString Then

            iYesNo = MsgBox("The Search Field Can Not Be Left Blank" & _
                             vbLf & vbLf & _
                            "Do You Want To Try Again?", vbYesNo + vbQuestion)

        End If

    Loop Until iYesNo <> vbYes

Hope this helps - please let me know how you get on.

Regards,

Greg M

**ssss2005** · 08-19-2015, 05:30 AM

Greg,

You're certainly not an idiot! You are in fact a Gentleman and a Scholar

This new code does EXACTLY what I required and the new smarter input loop does indeed tighten it up (just in case users start inputting numbers etc.)

I can't thank you enough, I have spent several months on this little problem and the internet couldn't seem to help me....Until now.

Thank you so much Greg.

**Greg M** · 08-19-2015, 06:54 AM

Hi again,

You're more than welcome!

A Gentleman and a Scholar? Do I detect an Irish undertone?

Delighted to have been able to help - anything further, just shout.

Best regards,

Greg M

**ssss2005** · 08-20-2015, 06:48 AM

Thanks once again Greg, after using it for a day or so now, it does exactly what I required it to do.

As for the Irish, aye, there's a fair bit. My Grandfather was a born and bred Dubliner until he married a Welsh girl and moved away. I still have family from that side mostly in and around Dublin (Drimnagh and Tallaght).

Surname of Keegan

Thank you ever so much for assisting me with this VBA code.

**Greg M** · 08-20-2015, 11:06 AM

Hi again,

Many thanks for the feedback and also for the personal information. 100% Dubliner here

Delighted to hear that your application is working successfully.

Best regards,

Greg M

Help required - User input for text search and delete remaining rows

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Help required - User input for text search and delete remaining rows

Re: Help required - User input for text search and delete remaining rows

Re: Help required - User input for text search and delete remaining rows

Re: Help required - User input for text search and delete remaining rows

Re: Help required - User input for text search and delete remaining rows

Re: Help required - User input for text search and delete remaining rows

Re: Help required - User input for text search and delete remaining rows

Re: Help required - User input for text search and delete remaining rows

Re: Help required - User input for text search and delete remaining rows

Re: Help required - User input for text search and delete remaining rows

Re: Help required - User input for text search and delete remaining rows

Thread Information

Users Browsing this Thread

Similar Threads

Macro to filter 2 columns and then delete remaining rows

[SOLVED] Delete rows, then reorganise remaining data

Automatically Add/Delete rows based on user input but check current table row count

Code will delete first 2 rows but not the remaining 10

Formula Required to work out remaining days via percentage complete data input

Find data and delete remaining rows (For each loop)

Delete rows based on user input

Bookmarks

Bookmarks

Posting Permissions