Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Old August 29th 18, 01:58 AM posted to microsoft.public.excel.programming
external usenet poster
 
First recorded activity by ExcelBanter: Aug 2012
Posts: 150
Default Email: Establishing Primary Cell vs. Ranges & Matches

Hi Claus

I did a revision of my original code which make it easier for you to understand my end goal.

So, the user will select a Cell in Column D of PF-Log, then hit the "Send Email". The code is meant to collect all the strings that will populate the email body.

The problem with the following is it throws an error he Dim myCell As Range: Set myCell = ActiveCell


Sub sendEmails()

Dim sWB As Workbook: Set sWB = ThisWorkbook
Dim sLog As Worksheet: Set sLog = sWB.Sheets("PF-Log")
Dim sHist As Worksheet: Set sHist = sWB.Sheets("Historical")
Dim sSup As Worksheet: Set sSup = sWB.Sheets("Support")

Dim myContact As Range: Set myContact = sSup.Range("D2100")
Dim myLoadID As Range: Set myLoadID = sHist.Range("B2:B30000")
Dim myCell As Range: Set myCell = ActiveCell

Dim EmailTo As String, EmailCC As String
Dim Who As String, When As String, Load As String
Dim Flow As String, Issue As String, Comment As String, Outcome As String
Dim iLoad As String, iPO As String, iVend As String, kSub As String, kDC As String
Dim iWoods As String, iSpaces As String, iWeight As String, iTime As String

Dim rngSource1 As Range, rngTarget1 As Range, rng1 As Range
Dim lLastRow1 As Long, LRow1 As Long

Dim rngSource2 As Range, rngTarget2 As Range, rng2 As Range
Dim lLastRow2 As Long, LRow2 As Long

Set rngTarget1 = Sheets("Support").Range("$D$2:$A$100")
Set rngSource1 = Sheets("PF-Log").myCell

lLastRow1 = rngSource1.Rows(rngSource1.Rows.Count).End(xlUp).R ow

For LRow1 = 2 To lLastRow1
Set rng1 = rngTarget1.Find(what:=rngSource1.Cells(LRow), LookAt:=xlWhole)
If Not rng1 Is Nothing Then
EmailTo = rng1.Offset(, 1).Value
EmailCC = rng1.Offset(, 2).Value
End If
Next LRow1

Who = myCell.Value
When = myCell.Offset(, -3).Value
Load = myCell.Offset(, -2).Value
Flow = myCell.Offset(, -1).Value
Issue = myCell.Offset(, 1).Value
Comment = myCell.Offset(, 2).Value
Outcome = myCell.Offset(, 3).Value

Set rngTarget2 = Sheets("Historical").Range("$B$2:$B$30000")
Set rngSource2 = Sheets("PF-Log").myCell.Offset(, -2)

lLastRow2 = rngSource2.Rows(rngSource2.Rows.Count).End(xlUp).R ow

For LRow2 = 2 To lLastRow2
Set rng2 = rngTarget2.Find(what:=rngSource2.Cells(LRow), LookAt:=xlWhole)
If Not rng2 Is Nothing Then
iLoad = rng2.Value
iPO = rng2.Offset(, 1).Value
iVend = rng2.Offset(, 3).Value
iSub = rng2.Offset(, 4).Value
iDC = rng2.Offset(, 5).Value
iWoods = rng2.Offset(, 8).Value
iSpaces = rng2.Offset(, 6).Value
iWeight = rng2.Offset(, 7).Value
iTime = rng2.Offset(, 12).Value
End If
Next LRow2

TIA
Mark

  #2   Report Post  
Old August 29th 18, 11:27 PM posted to microsoft.public.excel.programming
external usenet poster
 
First recorded activity by ExcelBanter: Apr 2011
Posts: 3,619
Default Email: Establishing Primary Cell vs. Ranges & Matches

Hi Mark,

Am Tue, 28 Aug 2018 17:58:05 -0700 (PDT) schrieb Living the Dream:

I did a revision of my original code which make it easier for you to understand my end goal.

So, the user will select a Cell in Column D of PF-Log, then hit the "Send Email". The code is meant to collect all the strings that will populate the email body.

The problem with the following is it throws an error he Dim myCell As Range: Set myCell = ActiveCell


< code snipped

Try:

Sub Mail()
Dim Who As String, When As String, LoadID As String, Flow As String, Issue As String, Comment As String, Outcome As String
Dim EmailTo As String, EmailCC As String, strBody As String
Dim iLoad As String, iPO As String, iVend As String, iSub As String, iDC As String, iWoods As String, iSpaces As String, iWeight As String, iTime As String
Dim LRow As Long
Dim c As Range
Dim OutApp As Object, OutMail As Object

Set OutApp = GetObject(, "Outlook.Application")
If OutApp Is Nothing Then Set OutApp =
CreateObject("Outlook.Application")
Set OutMail = OutApp.createitem(0)

With ActiveCell
Who = .Value
When = .Offset(, -3).Value
LoadID = .Offset(, -2).Value
Flow = .Offset(, -1).Value
Issue = .Offset(, 1).Value
Comment = .Offset(, 2).Value
Outcome = .Offset(, 3).Value
End With

With Sheets("Support")
Set c = .Range("D").Find(Who, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
EmailTo = .Cells(c.Row, "E")
EmailCC = .Cells(c.Row, "F")
End If
End With

With Sheets("Historical")
LRow = .Cells(Rows.Count, "A").End(xlUp).Row
Set c = .Range("B1:B" & LRow).Find(LoadID, LookIn:=xlValues,
lookat:=xlWhole)
If Not c Is Nothing Then
iLoad = c.Value
iPO = c.Offset(, 1).Value
iVend = c.Offset(, 3).Value
iSub = c.Offset(, 4).Value
iDC = c.Offset(, 5).Value
iWoods = c.Offset(, 8).Value
iSpaces = c.Offset(, 6).Value
iWeight = c.Offset(, 7).Value
iTime = c.Offset(, 12).Value
End If
End With

With Application
strBody = "Hi " & Who & .Rept(Chr(10), 2) & _
"As per our discussion regarding the following:" & .Rept(Chr(10), 2) & _
"Log Flow:" & .Rept(Chr(32), 15) & Flow & " - Log Date/Time: "
& When & .Rept(Chr(10), 2) & _
"Issue:" & .Rept(Chr(32), 22) & Issue & .Rept(Chr(10), 2) & _
"Comment:" & .Rept(Chr(32), 14) & Comment & .Rept(Chr(10), 2) & _
"Vendor:" & .Rept(Chr(32), 18) & iVend & Chr(10) & _
"Load ID:" & .Rept(Chr(32), 18) & iLoad & Chr(10) & _
"PO No(s):" & .Rept(Chr(32), 16) & iPO & Chr(10) & _
"Pallet(s):" & .Rept(Chr(32), 17) & iWoods & Chr(10) & _
"Space(s):" & .Rept(Chr(32), 17) & iSpaces & Chr(10) & _
"Weight:" & .Rept(Chr(32), 19) & iWeight & .Rept(Chr(10), 2) & _
"Collection Time:" & .Rept(Chr(32), 5) & iTime & .Rept(Chr(10), 2) & _
"Bound For:" & .Rept(Chr(32), 14) & iDC & .Rept(Chr(10), 2) & _
"Outcome:" & .Rept(Chr(32), 16) & Outcome
End With

With OutMail
.To = EmailTo
.CC = EmailCC
.Subject = iVend & " - " & iLoad
.Body = strBody
.Display '.send now throws up Security Marning so DO NOT USE.
End With
End Sub


Regards
Claus B.
--
Windows10
Office 2016


Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
looking for matches from 2 different sized ranges Bruceskin Excel Programming 0 November 22nd 09 04:26 AM
Excel Macro to Email specified ranges Susan Excel Discussion (Misc queries) 1 June 30th 08 03:51 PM
Copy two ranges without the interval rows to the email chelsea Excel Programming 2 June 26th 08 11:40 AM
How can I make Outlook Express my primary email for excel? Danielle P Excel Discussion (Misc queries) 2 March 24th 06 08:02 PM
establishing the background colour of a cell ac512 Excel Discussion (Misc queries) 4 April 15th 05 08:20 PM


All times are GMT +1. The time now is 08:49 AM.

Powered by vBulletin® Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
Copyright 2004-2018 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Copyright © 2017