Scan Excel column for specific word in VBA - vba

Question

Currently im working on a database Excel spreadsheet and im currently using VBA to implement some automatic functions to the system. Im new to VBA so i need your help :)
My question is this: I have a statues column in which the user needs to select from a drop list 'Complete' or 'In progress'. I need a program which can scan a specific column (example S3) for the word 'Complete'. Once the word is detected, the system will automatically send an email to a specific user tell him that the task has been complete.
Can anyone help me?
Thanks! :)
Update: I have coded the following to search for the word complete and send an email to the user (this is a rough idea)
Sub For_Loop_With_Step()
Dim lCount As Long, lNum As Long
Dim MyCount As Long
MyCount = Application.CountA(Range("S:S"))
For lCount = 1 To MyCount - 1 Step 1
If Cells(lCount + 2, 19) = "Complete" Then
Call Send_Email_Using_VBA
Else
MsgBox "Nothing found"
End If
Next lCount
MsgBox "The For loop made " & lNum & " loop(s). lNum is equal to " & lNum
End Sub
.
Sub Send_Email_Using_VBA()
Dim Email_Subject, Email_Send_From, Email_Send_To, _
Email_Cc, Email_Bcc, Email_Body As String
Dim Mail_Object, Mail_Single As Variant
Email_Subject = "Testing Results"
Email_Send_From = "fromperson#example.com"
Email_Send_To = "toperson#example.com"
'Email_Cc = "someone#example.com"
'Email_Bcc = "someoneelse#example.com"
Email_Body = "Congratulations!!!! You have successfully sent an e-mail using VBA !!!!"
On Error GoTo debugs
Set Mail_Object = CreateObject("Outlook.Application")
Set Mail_Single = Mail_Object.CreateItem(0)
With Mail_Single
.Subject = Email_Subject
.To = Email_Send_To
.cc = Email_Cc
.BCC = Email_Bcc
.Body = Email_Body
.send
End With
debugs:
If Err.Description <> "" Then MsgBox Err.Description
End Sub

Answer 1

Try this (Tried And Tested)
Screenshot:
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim i As Long, lRow As Long
Dim ExitLoop As Boolean
Dim aCell As Range, bCell As Range
'~~> Set this to the relevant sheet
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
'~~> Find the word in the relevant column. 19 is S Column
Set aCell = .Columns(19).Find(What:="Complete", LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
'~~> Update Col T appropriately
'~~> This is required so that mail doesn't go for the same row again
'~~> When you run the macro again
Set bCell = aCell
If Not .Range("T" & aCell.Row).Value = "Mail Sent" Then
If SendEmail = True Then
.Range("T" & aCell.Row).Value = "Mail Sent"
Else
.Range("T" & aCell.Row).Value = "Error: Mail Not Sent"
End If
End If
Do While ExitLoop = False
Set aCell = .Columns(19).FindNext(After:=aCell)
If Not aCell Is Nothing Then
If aCell.Address = bCell.Address Then Exit Do
If Not .Range("T" & aCell.Row).Value = "Mail Sent" Then
If SendEmail = True Then
.Range("T" & aCell.Row).Value = "Mail Sent"
Else
.Range("T" & aCell.Row).Value = "Error: Mail Not Sent"
End If
End If
Else
ExitLoop = True
End If
Loop
End If
End With
End Sub
Function SendEmail() As Boolean
Dim OutApp As Object, OutMail As Object
On Error GoTo Whoa
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = "toperson#example.com"
.Subject = "Testing Results"
.Body = "Your Message Goes Here"
.Display
End With
DoEvents
SendEmail = True
LetsContinue:
On Error Resume Next
Set OutMail = Nothing
Set OutApp = Nothing
On Error GoTo 0
Exit Function
Whoa:
SendEmail = False
Resume LetsContinue
End Function