VBA to check if none of cells have text

Tanyaann1995

Board Regular
Joined
Mar 24, 2021
Messages
57
Office Version
  1. 2016
Platform
  1. Windows
Hi,

I have a code that checks if a group of cells have a specific set of words in them and if the words are there, it executes a few functions. If the words are not there in that group of cells, I want a single message box to pop up at the end saying that the words are not found in any of the cells. Below is my sample code. But, when i try this code, the message box pops up 3 times due to the FOR loop and then shows an error message. I want the message box to pop up only once at the end after checking if all the cells have these words or not. Please can you advise if there is any other method to solve this.

Sub obsolete()

Dim i As Integer
Dim lRow As Long
Dim sCellVal As String
Dim pnFind As Range

lRow = ThisWorkbook.Worksheets(2).Range("E:E").Find(what:="*", _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row

For i = 24 To lRow
sCellVal = LCase$(Cells(i, 7).Value)
If sCellVal Like "*use*" Or _
sCellVal Like "*obs*" Or _
sCellVal Like "*obsolete*" Then
p = ThisWorkbook.Worksheets(2).Cells(i, 5).Value
Set pnFind = ThisWorkbook.Worksheets("Pricebook").Range("B:B").Find(what:=p, LookIn:=xlValues, LookAt:=xlWhole)
pnFind.EntireRow.Delete
ThisWorkbook.Worksheets(2).Cells(i, 5).Value = ThisWorkbook.Worksheets(2).Cells(i, 5).Value & "C5"
Else
MsgBox "No obsolete P/Ns found in list", vbOKOnly
Next i
End Sub
 

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
7,054
Office Version
  1. 2019
Platform
  1. Windows
Hi,
untested but see if this update to your code does what you want

VBA Code:
Sub obsolete()
    Dim i           As Long
    Dim lRow        As Long, counter As Long
    Dim sCellVal    As String
    Dim pnFind      As Range, rng As Range
   
    Set rng = ThisWorkbook.Worksheets("Pricebook").Range("B:B")
   
    With ThisWorkbook.Worksheets(2)
       
        lRow = .Range("E:E").Find(what:="*", LookAt:=xlPart, _
                                             LookIn:=xlFormulas, _
                                             SearchOrder:=xlByRows, _
                                             SearchDirection:=xlPrevious, _
                                             MatchCase:=False).Row
       
        For i = 24 To lRow
            sCellVal = LCase$(.Cells(i, 7).Value)
           
            If sCellVal Like "*use*" Or _
               sCellVal Like "*obs*" Or _
               sCellVal Like "*obsolete*" Then
            p = .Cells(i, 5).Value
           
            Set pnFind = rng.Find(what:=p, LookIn:=xlValues, LookAt:=xlWhole)
            If Not pnFind Is Nothing Then pnFind.EntireRow.Delete
           
            .Cells(i, 5).Value = .Cells(i, 5).Value & "C5"
            counter = counter + 1
        End If
        Set pnFind = Nothing
    Next i
   
    End With


    If counter = 0 Then
        MsgBox "No obsolete P/Ns found in list", 48, "Not Found"
    Else
        MsgBox counter & " P/Ns found in list", 64, "Records Found"
    End If

End Sub

Dave
 
Solution

Tanyaann1995

Board Regular
Joined
Mar 24, 2021
Messages
57
Office Version
  1. 2016
Platform
  1. Windows
Hi,
untested but see if this update to your code does what you want

VBA Code:
Sub obsolete()
    Dim i           As Long
    Dim lRow        As Long, counter As Long
    Dim sCellVal    As String
    Dim pnFind      As Range, rng As Range
  
    Set rng = ThisWorkbook.Worksheets("Pricebook").Range("B:B")
  
    With ThisWorkbook.Worksheets(2)
      
        lRow = .Range("E:E").Find(what:="*", LookAt:=xlPart, _
                                             LookIn:=xlFormulas, _
                                             SearchOrder:=xlByRows, _
                                             SearchDirection:=xlPrevious, _
                                             MatchCase:=False).Row
      
        For i = 24 To lRow
            sCellVal = LCase$(.Cells(i, 7).Value)
          
            If sCellVal Like "*use*" Or _
               sCellVal Like "*obs*" Or _
               sCellVal Like "*obsolete*" Then
            p = .Cells(i, 5).Value
          
            Set pnFind = rng.Find(what:=p, LookIn:=xlValues, LookAt:=xlWhole)
            If Not pnFind Is Nothing Then pnFind.EntireRow.Delete
          
            .Cells(i, 5).Value = .Cells(i, 5).Value & "C5"
            counter = counter + 1
        End If
        Set pnFind = Nothing
    Next i
  
    End With


    If counter = 0 Then
        MsgBox "No obsolete P/Ns found in list", 48, "Not Found"
    Else
        MsgBox counter & " P/Ns found in list", 64, "Records Found"
    End If

End Sub

Dave
Thanks :) This worked perfectly
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,152,396
Messages
5,769,841
Members
425,574
Latest member
grimeslisa

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
Top