CODEWITHSUNDEEP
excelvba
Que
Que

Reputation: 1

How To Stack Multiple Macros into one?

I have found the following Macro and used it to my needs to copy range and create an email, I have copied the same code into several sheets, couple of things change in each code the range, email addresses & subject. How can I stack all these macros into one:

Sub Macro_Qu()
'
' Macro_Qu Macro

' Don't forget to copy the function RangetoHTML in the module.
' Working in Office 2000-2010
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set rng = Nothing
    On Error Resume Next
    Set rng = Sheets("Qusai").Range("A2:J20").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    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

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = "[email protected]"
        .CC = ""
        .BCC = ""
        .Subject = "Test"
        .HTMLBody = RangetoHTML(rng)
        .Display   'or use .Send
    End With
    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

Upvotes: 0

Views: 67

Answers (2)

Graham
Graham

Reputation: 7802

You can use this to call other macros from inside another macro:

call <macro name>

However, if you're starting to get this complex it might be time to learn VBA :)

Upvotes: 0

YowE3K
YowE3K

Reputation: 23974

Just pass the values that change as parameters:

Sub Test
    Macro_Qu Sheets("Qusai").Range("A2:J20"), "[email protected]", "Test"
End Sub

Sub Macro_Qu(parmRng As Range, parmTo As String, parmSubject As String)
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set rng = Nothing
    On Error Resume Next
    Set rng = parmRng.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    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

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = parmTo
        .CC = ""
        .BCC = ""
        .Subject = parmSubject
        .HTMLBody = RangetoHTML(rng)
        .Display   'or use .Send
    End With
    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing    
End Sub

Upvotes: 2

Related Questions