Excel, Routing Slips, and VBA

[Mike Coleman]

I am trying to improve a workbook which has a VBA automated
routing-slip program. The program worked fine in simple form, routing
the workbook to recipients listed in one of the worksheets. It could
even change the routing list based on certain conditions. Now I want
to perform one more logical check, adding a single email address to
the top of the routing list based on the contents of a cell on one of
the worksheets (see VBA code below). The problem is that I do not
know how to add this name to the top of the email list I am using in
the routing slip. The original routing list is an array taken from
one of the worksheets. I cannot figure how to add a single name to
the array. The attached code does seem to add the name to the array,
but the routing procedure breaks down when the value of PCYES is "X".
I am comfortable with VBA for Access, but not Excel (and arrays)…………
any help from Excel-VBA programmers? Thanks a bunch.


Mike Coleman

**********************************************************************
Sub SendCER()
On Error Resume Next
Dim amount, BudgetNo, BudgetYes, PCNO, PCYES As String
Dim PLANTBOX, RTBOX, MAIL1 As String
Dim EmailList

ActiveWorkbook.HasRoutingSlip = True
ActiveWorkbook.RoutingSlip.Delivery = xlOneAfterAnother

amount = (Worksheets("Summary").Range("CER_amount").Value)
BudgetNo = Worksheets("Summary").Range("budget_no").Value
BudgetYes = Worksheets("Summary").Range("budget_yes").Value
PCYES = Worksheets("Summary").Range("PCYES").Value
PLANTBOX = Worksheets("Summary").Range("plant_box").Value
RTBOX = Worksheets("Summary").Range("RT_box").Value

' Is this a PC or IT Related project? If so route to IT Mgr first

' >>>>>>>> Create ROUTING LIST based on GROUP (PLANT or R&T), $
amount, In or OUT of Budget
' ******** PLANT & IN BUDGET *******
' <$25,000
If PLANTBOX = "X" And amount <= 25000 Then
EmailList = Worksheets("Routing").Range("c6:c18")

' >$25,000 AND <= $100,000
ElseIf PLANTBOX = "X" And amount > 25000 And amount <= 100000 And
BudgetNo <> "X" Then
EmailList = Worksheets("Routing").Range("d6:d18")

' >$100,000 AND <= $250,000
ElseIf PLANTBOX = "X" And amount > 100000 And amount <= 250000 And
BudgetNo <> "X" Then
EmailList = Worksheets("Routing").Range("e6:20")

' > $250,000
ElseIf PLANTBOX = "X" And amount > 250000 And BudgetNo <> "X" Then
EmailList = Worksheets("Routing").Range("f6:f21")


' ******* PLANT & NOT IN BUDGET *******
' >$25,000 AND <= $100,000
ElseIf PLANTBOX = "X" And amount > 25000 And amount <= 100000 And
BudgetYes <> "X" Then
EmailList = Worksheets("Routing").Range("c24:c34")

' >$100,000 AND <= $250,000
ElseIf PLANTBOX = "X" And amount > 150000 And amount <= 500000 And
BudgetYes <> "X" Then
EmailList = Worksheets("Routing").Range("d24:c38")

' >$100,000 AND <= $250,000
ElseIf PLANTBOX = "X" And amount > 100000 And amount <= 250000 And
BudgetYes <> "X" Then
EmailList = Worksheets("Routing").Range("e24:c39")

' > $250,000
ElseIf PLANTBOX = "X" And amount > 250000 And BudgetYes <> "X" Then
EmailList = Worksheets("Routing").Range("f24:c40")

End If

' ******** R&T & IN BUDGET *******
' <$25,000
If RTBOX = "X" And amount <= 25000 Then
EmailList = Worksheets("Routing").Range("c44:c52")

' >$25,000 AND <= $100,000
ElseIf RTBOX = "X" And amount > 25000 And amount <= 100000 And
BudgetNo <> "X" Then
EmailList = Worksheets("Routing").Range("d44:d56")

' >$100,000 AND <= $250,000
ElseIf RTBOX = "X" And amount > 100000 And amount <= 250000 And
BudgetNo <> "X" Then
EmailList = Worksheets("Routing").Range("e44:e58")

' > $250,000
ElseIf RTBOX = "X" And amount > 250000 And BudgetNo <> "X" Then
EmailList = Worksheets("Routing").Range("f44:f59")


' ******* R&T & NOT IN BUDGET *******

' >$25,000 AND <= $100,000
ElseIf RTBOX = "X" And amount > 25000 And amount <= 100000 And
BudgetYes <> "X" Then
EmailList = Worksheets("Routing").Range("c63:c72")


' >$100,000 AND <= $250,000
ElseIf RTBOX = "X" And amount > 150000 And amount <= 500000 And
BudgetYes <> "X" Then
EmailList = Worksheets("Routing").Range("d63:c77")

' >$100,000 AND <= $250,000
ElseIf RTBOX = "X" And amount > 100000 And amount <= 250000 And
BudgetYes <> "X" Then
EmailList = Worksheets("Routing").Range("e63:c78")

' > $250,000
ElseIf RTBOX = "X" And amount > 250000 And BudgetYes <> "X" Then
EmailList = Worksheets("Routing").Range("f63:c78")

End If

' Is this a PC or IT Related Project? If so, add IT Mgr email address
first
' ******** THIS IS THE ADDED CODE WHICH IS FAILING THE PROGRAM
**********

If PCYES = "X" Then
MAIL1 = "Tom Jones"
EmailList = Array(MAIL1, EmailList)
End If
' ***************************************************************************

' Create ROUTING SLIP and Route Workbook

With ActiveWorkbook.RoutingSlip
.Recipients = EmailList
.Message = Worksheets("Routing").Range("b4").Value
.Subject = Worksheets("Routing").Range("b3").Value
.ReturnWhenDone = True
.TrackStatus = True
End With
ActiveWorkbook.Route