VBA Coding To Automatically Send Emails Within a Column of Values

Hi Relatively new to the forums: been browsing the majority of post to try and edit the VBA codes to my needs. I've yet to succeed with my attempt.
Project in short: I'm creating a complaints log, Straight forward stuff complaints are entered and edited via userforms which then place the data onto the Database tab, what I'd like to implement is an email system that will automatically send an email if a certain complaint goes over a certain date (lets define this variable as X). I want the VBA code to look at column T and see if there is a 1 if not it should look at column S to find the a Value (this is an if statement saying if the date difference X goes over a set limit put a 1), if it does send an email from that particular row then place a 1 in column T. This should hopefully eliminate spam.
This will increase in size (so a predefined range won't work) don't take the format I've uploaded as the actual document.
I'd like the email to contain certain values within that specific row, Customer ID, Customer Name and Department
Now I've browsed forums and looked on a few sites (that Rob site about sending emails), Nothing has met the criteria I'm after
I've attached the workbook any help will be greatly appreciated

Let me simplify these words as they are confusing and are not all necessary.

In a predefined column (lets say column G) there will be a list of 1's and 0's. If a "1" is in the cell then i want to send an email (the address will be in the same row in another column, changes for different complaints) if there is a "0" then we don't want an email to be sent

sooo..


the vba code basically needs to look down the column, find the "1"'s and send the email automatically to the relevant address.

I am comfortable with sending emails via vba, the part i am struggling with is looking down the entire column as apposed to a specific cell.

I hope someone can help

Kind Regards

Lance

So, something like:

Public Sub CheckDatabase()

    Dim rngColumnStart      As Excel.Range

    Dim arrValues           As Variant

    Dim intCol              As Integer
    Dim lngLastRow          As Long
    Dim lngCurrRow          As Long

    Set rngColumnStart = Worksheets("Database").Range("S3")

    intCol = rngColumnStart.Column
    On Error Resume Next
    lngLastRow = rngColumnStart.Parent.Columns(intCol).Find(What:="*", _
        After:=Worksheets("Database").Cells(1, intCol), _
        SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
        LookAt:=xlPart, LookIn:=xlValues).Row
    If Err > 0 Then
        lngLastRow = 0
    End If
    On Error GoTo 0
    If lngLastRow > 0 Then
        arrValues = rngColumnStart.Resize(lngLastRow - rngColumnStart.Row + 1, 1).Value
        For lngCurrRow = LBound(arrValues) To UBound(arrValues)
            If arrValues(lngCurrRow, 1) = 1 Then
                Call SendEMail(rngColumnStart.Offset(lngCurrRow - 1, 1 - rngColumnStart.Column))
            End If
        Next lngCurrRow
    End If
    
End Sub

Change the Range to match the starting cell of your column, I guessed it was Database!S3. This will read the entire column into an array, then loop through the array looking for 1's. When it finds one, it will call the SendEMail procedure, passing it a range of column A in the selected row. SendEMail could start like this:

Public Sub SendEMail(ByVal rngStart As Excel.Range)

    Dim arrComplaint            As Variant

    arrComplaint = rngStart.Resize(1, 20).Value

    
End Sub

Hi there Wallyeye and Chippy, sorry for the delayed reply just turned the pc on!
The code doesn't seem to do what I want to it to do, I'll reiterate the points to help clarify what I need the code to do:

Look through many rows down Column "T" to Find any cells with the value "1"

IF "1" is Found Send Mail via outlook, the body of the email will consist of the information in the relevant rows in column A B and C

the code needs to look at all the rows in that column, and not just stop at the first "1"

However IF a 0 is within Column T do nothing

if you can post a workbook example as opposed to code I'd appreciate it

the email address is a fixed email address which can be hard coded

If you paste the code from my post into a new module in the workbook you posted, and step through it using the F8 key, you will see that it starts at the given location, looping through all values in the column. Each time it finds a 1, it will call the SendEMail routine, passing it a range object pointed to column A of the found row. The SendEMail template I posted puts data from the found row into arrComplaint, where you can use it to send your email using your standard process.

Hi there Wallyeye
what does that Star entail with in find.(What="*")
I've stepped into the code (done that prior to my first reply) it doesn't select the row and the arrcomplaint value is empty. Maybe it's me not being able to understand where to look at sorry for the endless questions!

The Star (asterisk) will match any value in the given range.

Did you change the rngColumnStart to point to the first 0/1 value?

I'll test it first thing tomorrow when I have the code in front of me unfortunatly I don't have access to it at the moment! If I have any issues I'll just update you with the troubles I have.

Appreciate your help thus far

Hi again,
I've attached the code I've generated to send emails, the only issue I seem to be having now is extracting the required data from that row, I'm not to sure how the arrComplaint works. I've tried using the celloffset(0,0).Value but it doesn't seem to work

Any help is apperciated!
and once again thanks wallyeye for the help

Public Sub SendEMail(ByVal rngStart As Excel.Range)

    Dim arrComplaint            As Variant

    arrComplaint = rngStart.Resize(1, 20).Value


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
 
    On Error Resume Next
    With OutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = "Complaint ID" & "arrComplaint"
        .Body = "Complaint ID " & "arrComplaint" & "Has has no progress for 5 days"
        .Display
    End With
    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
 
    Set OutMail = Nothing
    Set OutApp = Nothing
    
End Sub

So, it would end up looking at values within the arrComplaint array:

Public Sub SendEMail(ByVal rngStart As Excel.Range)

    Dim arrComplaint            As Variant

    arrComplaint = rngStart.Resize(1, 20).Value


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
 
    On Error Resume Next
    With OutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = "Complaint ID" & cstr(arrComplaint(1,1))
        .Body = "Complaint ID " & cstr(arrComplaint(1,1)) & " has no progress for 5 days"
        .Display
    End With
    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
 
    Set OutMail = Nothing
    Set OutApp = Nothing
    
End Sub

You would change the second 1 to bring up different columns from the database, i.e.:

arrcomplaint(1,8)

would show the department.

Thanks once again wallyeye, I'll test the code out first thing Monday morning (don't have access to the actual database currently) I'll be sure to mark the thread as solved if the code works (which I'm sure it will)! If not I'll just pester you a little more

Hi again, Got the code working only thing I need now is for it to write a "1" within a column R, using the arrComplaint Variable.

You would probably do the update within your CheckDatabase module, right after the SendEMail call:

                Call SendEMail(rngColumnStart.Offset(lngCurrRow - 1, 1 - rngColumnStart.Column))
                rngColumnStart.Offset(lngCurrRow - 1, 18 - rngColumnStart.Column).value = 1

18 being the column number of column R. It would be just as easy to do it within SendEMail:

rngstart.offset(0,18-rngstart.column).value = 1

Thanks a lot Wallyeye! I've given you rep for the posts and I owe you

Cool! Glad to be of help.