VBA to check if none of cells have text

[Tanyaann1995]

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

 

[dmt32]

Hi,
untested but see if this update to your code does what you want

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

 

[Tanyaann1995]

Hi,
untested but see if this update to your code does what you want

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

 

[dmt32]

Thanks This worked perfectly

welcome - appreciate the feedback

Dave