VBA searching column for criteria and copying data from Excel to

Resolved · Low Priority · Version 2010

Wed 6 Feb 2019, 14:58 Delegate Adam said...

Adam has attended:
Excel VBA Introduction course
Excel VBA Intermediate course
Excel VBA Advanced course

VBA searching column for criteria and copying data from Excel to

Hi,

I would like to use VBA to Search column C for criteria "YES" and if a match copy data in cells A, B, E & F in to an email.

I've managed to create an email but struggling with transferring the data from excel to email.

Sub Mail_small_Text_Outlook()
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)

On Error Resume Next
With xOutMail
.To = "Email Address"
.CC = ""
.BCC = ""
.Subject = "TEST"
.Body = "Hello"
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing

End Sub

Thanks,

Wed 6 Feb 2019, 19:55 Trainer Jens said...

RE: VBA searching column for criteria and copying data from Exce

Hi Adam,

Thank you for the forum question.

Normally we do not write code for clients in the forum we are answering question, but I found the idea interesting. I have a suggestion to how it can be done.

Please see code below:

Option Base 1

Sub MailTextOutlook()

Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Dim i As Integer
Dim j As Integer
Dim cellValue() As String
Dim NoOfYes As Integer
Dim x: x = 0

Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)

NoOfYes = Application.WorksheetFunction.CountIf(Range("c2:c20"), "Yes")
ReDim cellValue(NoOfYes)
Range("C2").Select
For j = 1 To Range("c1").CurrentRegion.Rows.Count - 1

If ActiveCell.Value = "Yes" Then
i = i + 1
cellValue(i) = Cells(ActiveCell.Row, 1) & " " & Cells(ActiveCell.Row, 2) _
& " " & Cells(ActiveCell.Row, 5) & " " & Cells(ActiveCell.Row, 6)

End If
ActiveCell.Offset(1, 0).Select
Next j

On Error Resume Next
With xOutMail
.To = "Email Address"
.CC = ""
.BCC = ""
.Subject = "TEST"
.body = "Hello " & vbNewLine _

For j = LBound(cellValue) To UBound(cellValue)
cellValue (j) & vbNewLine

Next

.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing

End Sub

Kind regards

Jens Bonde
Microsoft Office Specialist Trainer

Tel: 0207 987 3777
STL - https://www.stl-training.co.uk
98%+ recommend us

London's leader with UK wide delivery in Microsoft Office training and management training to global brands, FTSE 100, SME's and the public sector