I have a macro that emails a sales person their pipeline, the data is contained in columns A through H but I also want to send data in columns K and L without the columns in between (columns I and J) Here is the part that I think I need to change: Set rng = ActiveSheet.Range("a6", ActiveSheet.Range("H6").End(xlDown))
But here is the complete code:
Sub Pipeline_EmailHLONetRegs()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim Signature As String
Dim mysht As Worksheet
Dim myDropDown As Shape
Dim myVal As String
Dim RegRng As Range
Dim PrevRegRng As Range
Dim ManagerRng As RangeSet mysht = ThisWorkbook.Worksheets("Pipeline")
Set myDropDown = mysht.Shapes("Drop Down 261")
myVal = myDropDown.ControlFormat.List(myDropDown.ControlFormat.Value)
Set RegRng = Worksheets("Validation").Range("D:D").Find(What:=myVal, LookAt:=xlWhole)
Set PrevRegRng = Worksheets("Validation").Range("D:D").Find(What:=myVal, LookAt:=xlWhole)
Set ManagerRng = Worksheets("Validation").Range("D:D").Find(What:=myVal, LookAt:=xlWhole)
'
If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
ActiveSheet.ShowAllData
End If
ActiveSheet.Range("$a$6:$AQ$1000").AutoFilter Field:=34, Criteria1:="<>Pre-Approval"
ActiveSheet.Range("$A$6:$AQ$1000").AutoFilter Field:=1, Criteria1:=myVal
NumberofRegs = RegRng.Offset(0, 1).Value
PrevNumberofRegs = PrevRegRng.Offset(0, 2).Value
Manager = ManagerRng.Offset(0, 3).ValueSet rng = Nothing
' Only send the visible cells in the selection.
Set rng = ActiveSheet.Range("a6", ActiveSheet.Range("H6").End(xlDown))If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected. " & _
vbNewLine & "Please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.EnableEvents = False
.ScreenUpdating = False
End WithSet OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.Display
End With
Signature = OutMail.HTMLBody
strbody = "<br />" & ActiveSheet.Range("A1") & " " & ActiveSheet.Range("B1") & "<br />" & ActiveSheet.Range("A2") & Split(ActiveSheet.Range("B2").Text, ".")(0) & "<br />" & "Previous Month Registrations = " & PrevNumberofRegs & "<br />" & "Current Registrations MTD = " & NumberofRegsWith OutMail
.to = myVal
.cc = Manager
.Subject = "Your Net Reg Pipeline"
.HTMLBody = "<BODY style=font-size:12.5pt;font-family:Calibri>" & "</p>" & strbody & RangetoHTML(rng) & Signature
.Display
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
'range("A7:AQ625").Borders.LineStyle = xlNone
'range("A7:AQ625").Borders(xlEdgeLeft).LineStyle = xlNone
'Selection.Borders.LineStyle = xlNoneSet OutMail = Nothing
Set OutApp = NothingEnd Sub
Try this: lastRw = ActiveSheet.Range("H6").End(xlDown).Row Set Rng = Application.Union(ActiveSheet.Range("A6:H" & lastRw), _ ActiveSheet.Range("K6:L" & lastRw)) MsgBox Rng.AddressClick Here Before Posting Data or VBA Code ---> How To Post Data or Code.
I've mentioned this before...perhaps you simply forgot. First, a posting tip:
Please click on the blue line at the end of this post and read the instructions on how to post VBA code in this forum so that it is easier for us to read. Then edit/repost your code so that it looks similar to the example found via that link.
Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.
Sub Pipeline_EmailHLONetRegs() Dim rng As Range Dim OutApp As Object Dim OutMail As Object Dim Signature As String Dim mysht As Worksheet Dim myDropDown As Shape Dim myVal As String Dim RegRng As Range Dim PrevRegRng As Range Dim ManagerRng As Range Set mysht = ThisWorkbook.Worksheets("Pipeline") Set myDropDown = mysht.Shapes("Drop Down 261") myVal = myDropDown.ControlFormat.List(myDropDown.ControlFormat.Value) Set RegRng = Worksheets("Validation").Range("D:D").Find(What:=myVal, LookAt:=xlWhole) Set PrevRegRng = Worksheets("Validation").Range("D:D").Find(What:=myVal, LookAt:=xlWhole) Set ManagerRng = Worksheets("Validation").Range("D:D").Find(What:=myVal, LookAt:=xlWhole) ' If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then ActiveSheet.ShowAllData End If ActiveSheet.Range("$a$6:$AQ$1000").AutoFilter Field:=34, Criteria1:="<>Pre-Approval" ActiveSheet.Range("$A$6:$AQ$1000").AutoFilter Field:=1, Criteria1:=myVal NumberofRegs = RegRng.Offset(0, 1).Value PrevNumberofRegs = PrevRegRng.Offset(0, 2).Value Manager = ManagerRng.Offset(0, 3).Value Set rng = Nothing ' Only send the visible cells in the selection. Set rng = ActiveSheet.Range("a6", ActiveSheet.Range("H6").End(xlDown)) If rng Is Nothing Then MsgBox "The selection is not a range or the sheet is protected. " & _ vbNewLine & "Please correct and try again.", vbOKOnly Exit Sub End If With Application .EnableEvents = False .ScreenUpdating = False End With Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) With OutMail .Display End With Signature = OutMail.HTMLBody strbody = "<br />" & ActiveSheet.Range("A1") & " " & ActiveSheet.Range("B1") & "<br />" & ActiveSheet.Range("A2") & Split(ActiveSheet.Range("B2").Text, ".")(0) & "<br />" & "Previous Month Registrations = " & PrevNumberofRegs & "<br />" & "Current Registrations MTD = " & NumberofRegs With OutMail .to = myVal .cc = Manager .Subject = "Your Net Reg Pipeline" .HTMLBody = "<BODY style=font-size:12.5pt;font-family:Calibri>" & "</p>" & strbody & RangetoHTML(rng) & Signature .Display End With On Error GoTo 0 With Application .EnableEvents = True .ScreenUpdating = True End With 'range("A7:AQ625").Borders.LineStyle = xlNone 'range("A7:AQ625").Borders(xlEdgeLeft).LineStyle = xlNone 'Selection.Borders.LineStyle = xlNone Set OutMail = Nothing Set OutApp = Nothing End Sub
Sorry DerbyDad03, correction made; I did forget and using the pre tags makes it look much better.
Question: When you open the code in the VBA editor, is the code left justified as it is in your post or are sections of the code indented as shown below?
Option Explicit Private Sub ColorNumbers() Dim rw As Integer For rw = 1 To 56 Cells(rw, 1).Formula = rw Cells(rw, 2).Interior.ColorIndex = rw Next MsgBox "Your List Of Color Index Values Is Complete" End SubThe point of using the pre tags is that the indents seen in the VBA editor are retained when the code is copied to the forum. The indents are what make VBA code easier to read and the pre tags are used to retain those indents.
Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.
DerbyDad03, now that I am properly using the pretags do you think you
could weigh in on this problem?I have a macro that emails a sales person their pipeline, the data is
contained in columns A through H but I also want to send data in
columns K and L without the columns in between (columns I and J)Here is the part that I think I need to change:
Set rng = ActiveSheet.Range("a6", ActiveSheet.Range("H6").End(xlDown))Here is the complete code:
Sub Pipeline_EmailHLONetRegs() ActiveSheet.Unprotect Dim rng As Range Dim OutApp As Object Dim OutMail As Object Dim Signature As String Dim mysht As Worksheet Dim myDropDown As Shape Dim myVal As String Dim RegRng As Range Dim PrevRegRng As Range Dim ManagerRng As Range Dim SourceRng As Range Dim RngAddress As String Set mysht = ThisWorkbook.Worksheets("Pipeline") Set myDropDown = mysht.Shapes("Drop Down 261") myVal = myDropDown.ControlFormat.List(myDropDown.ControlFormat.Value) If myVal = "Choose HLO" Then MsgBox "Please Choose an HLO, then try again.", vbExclamation Exit Sub End If Set RegRng = Worksheets("Validation").Range("D:D").Find(What:=myVal, LookAt:=xlWhole) Set PrevRegRng = Worksheets("Validation").Range("D:D").Find(What:=myVal, LookAt:=xlWhole) Set ManagerRng = Worksheets("Validation").Range("D:D").Find(What:=myVal, LookAt:=xlWhole) Set SourceRng = Worksheets("Source").Range("A:A").Find(What:=myVal, LookAt:=xlWhole) ' If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then ActiveSheet.ShowAllData End If ActiveSheet.Range("$a$6:$AQ$1000").AutoFilter Field:=34, Criteria1:="<>Pre-Approval" ActiveSheet.Range("$A$6:$AQ$1000").AutoFilter Field:=1, Criteria1:=myVal NumberofRegs = RegRng.Offset(0, 1).Value PrevNumberofRegs = PrevRegRng.Offset(0, 2).Value Manager = ManagerRng.Offset(0, 3).Value If RefSource = Empty Then MsgBox "HLO has no Loans" Exit Sub End If RefSource = SourceRng.Offset(0, 8).Value FormattedRefSource = Format(RefSource, "General Number") Set rng = Nothing ' Only send the visible cells in the selection. Set rng = ActiveSheet.Range("a6", ActiveSheet.Range("H6").End(xlDown)) If rng Is Nothing Then MsgBox "The selection is not a range or the sheet is protected. " & _ vbNewLine & "Please correct and try again.", vbOKOnly Exit Sub End If With Application .EnableEvents = False .ScreenUpdating = False End With Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) With OutMail .Display End With Signature = OutMail.HTMLBody strbody = ActiveSheet.Range("A1") & " " & ActiveSheet.Range("B1") & "<br />" & ActiveSheet.Range("A2") & Split(ActiveSheet.Range("B2").Text, ".")(0) & "<br />" & "YTD Bank Referred % = " & FormattedRefSource & "%" & "<br />" & "Previous Month Registrations = " & PrevNumberofRegs & "<br />" & "Current Registrations MTD = " & NumberofRegs With OutMail .to = myVal .cc = Manager .Subject = "Your Net Reg Pipeline" .HTMLBody = "<BODY style=font-size:11pt;font-family:Calibri>" & "</p>" & strbody & RangetoHTML(rng) & Signature .Display End With On Error GoTo 0 With Application .EnableEvents = True .ScreenUpdating = True End With Set OutMail = Nothing Set OutApp = Nothing ActiveSheet.Protect End Sub
Try this: lastRw = ActiveSheet.Range("H6").End(xlDown).Row Set Rng = Application.Union(ActiveSheet.Range("A6:H" & lastRw), _ ActiveSheet.Range("K6:L" & lastRw)) MsgBox Rng.AddressClick Here Before Posting Data or VBA Code ---> How To Post Data or Code.
Thanks DerbyDad03, worked like a champ!
Since the code is calculating the last row anyway, I would use that to determine if the filter range is empty (your other question) If lastRw =1048576 Then 'Don't bother setting the RngThat would more efficient than checking the Rng.Address after the Rng was set
Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.