Tanyaann1995
Board Regular
- Joined
- Mar 24, 2021
- Messages
- 62
- Office Version
- 2016
- Platform
- 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
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