none
Set My Range In VBA To Be A Continuous Set Of Columns and then skip 2 columns and include 2 others RRS feed

  • Question

  • 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 but not sure how to make the 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


    MEC

    Tuesday, July 19, 2016 11:28 AM

Answers

  • I was able to get it to work using this code:

    LastRw = ActiveSheet.Range("H6").End(xlDown).Row
      Set rng = Application.Union(ActiveSheet.Range("B6:H" & LastRw), _
                                  ActiveSheet.Range("AE6:AE" & LastRw), _
                                  ActiveSheet.Range("K6:K" & LastRw), _
                                  ActiveSheet.Range("O6:O" & LastRw))


    MEC

    • Proposed as answer by David_JunFeng Monday, July 25, 2016 6:06 AM
    • Marked as answer by David_JunFeng Wednesday, July 27, 2016 9:55 AM
    Friday, July 22, 2016 11:51 AM

All replies

  • >>> 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 but not sure how to make the change: Set rng = ActiveSheet.Range("a6", ActiveSheet.Range("H6").End(xlDown))<<<

    According to your description, you could select discontinuous range, like this:

    ActiveSheet.Range("A6:H440, K6:L440").Select

    or refer to below code:
    Sub DemoRange()
    
       Dim rngAddress As String
       rngAddress = "A6" & ":H" & ActiveSheet.Range("H6").End(xlDown).Row & ","
       rngAddress = rngAddress & "K6" & ":L" & ActiveSheet.Range("L6").End(xlDown).Row
       Set Rng = ActiveSheet.Range(rngAddress)
       Rng.Select
       
    End Sub

    Wednesday, July 20, 2016 6:18 AM
  • Thanks for the attempt but I got a Run-time error 1004 "That command cannot be used on multiple selections" the command it is referring to is rng.copy

    MEC

    Thursday, July 21, 2016 11:59 AM
  • >>>but I got a Run-time error 1004 "That command cannot be used on multiple selections" the command it is referring to is rng.copy

    According to your description, I have made a sample to try to reproduce this issue, but I am not able.

    Sub Demo()
    
       ActiveSheet.Range("A1:H4, K1:L4").Copy
       
    End Sub

    But as far as I know that when you attempt to copy nonadjacent cell selections, you may receive one of the following error messages "That command cannot be used on multiple selections.". So I suggest that you could make sure that rng is not nonadjacent cell selections.

    For more information, click here to refer about Error Message "That Command Cannot Be Used on Multiple Selections"

    Friday, July 22, 2016 6:01 AM
  • I was able to get it to work using this code:

    LastRw = ActiveSheet.Range("H6").End(xlDown).Row
      Set rng = Application.Union(ActiveSheet.Range("B6:H" & LastRw), _
                                  ActiveSheet.Range("AE6:AE" & LastRw), _
                                  ActiveSheet.Range("K6:K" & LastRw), _
                                  ActiveSheet.Range("O6:O" & LastRw))


    MEC

    • Proposed as answer by David_JunFeng Monday, July 25, 2016 6:06 AM
    • Marked as answer by David_JunFeng Wednesday, July 27, 2016 9:55 AM
    Friday, July 22, 2016 11:51 AM