Solved set my range in VBA to be a continuous set of columns ...

July 18, 2016 at 18:23:03
Specs: Windows 7
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 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


See More: set my range in VBA to be a continuous set of columns ...

Report •

✔ Best Answer
July 21, 2016 at 19:42:23
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.Address

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


See in Thread ↓

#1
July 18, 2016 at 20:18:15
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.


Report •

#2
July 19, 2016 at 04:33:11
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


Report •

#3
July 19, 2016 at 04:34:30
Sorry DerbyDad03, correction made; I did forget and using the pre tags makes it look much better.

Report •

Related Solutions
See More ↓

#4
July 19, 2016 at 06:43:59
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 Sub

The 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.


Report •

#5
July 21, 2016 at 15:38:31
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


Report •

#6
July 21, 2016 at 19:42:23
✔ Best Answer
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.Address

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#7
July 21, 2016 at 20:41:38
Thanks DerbyDad03, worked like a champ!

Report •

#8
July 22, 2016 at 03:01:27
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 Rng

That 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.


Report •

#9
July 22, 2016 at 04:32:18
ok got it, thanks

Report •
Start a discussion

Ask Question