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("D2:D100")
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
|