Cycle through Choices as Variant

[Solarissf]

Hi Guys,

So I have this pretty big program and I have a question about one part.
Basically for each case it is sending an email to multiple people.
My question is, when it goes to each case does this automatically know to do every email in the list. The reason I ask is because I noticed every once in a while it was sending to people not even in that particular case. Does it have something to do the the number I'm putting in the Variant part?
How do I make sure it sends to only people I specify in each case?

THANKS

Dim cust(25) As Variant
                Case 4: strAccount = "0LC 915586"
                    cust(0) = "stephen.xxxx@xxx.com"
                    cust(1) = "robert.xxx@xxx.com"
                    cust(2) = "gicxxx@xxxx.net"
                    cust(3) = "fxxxx@xxx.com"
                Case 5: strAccount = "0LC 915608"
                    cust(0) = "xxxx.xx@xxx.com"
                    cust(1) = "xx.xx@xxx.com"
                    cust(2) = "carlos.xxre@xxx.com"
                Case 6: strAccount = "0LC 915560"
                    cust(0) = "jcauxxx@sxxxis.com"
                    cust(1) = "stexxxhen.foxxo@bxxxe.com"
                    cust(2) = ""
oDoc.sendto = cust

[Leith Ross]

Hello Solarissf,

To make your posts easier to read and preserve your formatting, please wrap your code. I did it for you this time. Here is how you can do it next time.

How to wrap your Code
On the Message window Toolbar you will see the # icon. This will automatically wrap the text you selected with the proper HTML tags to create a Code Window in your post. You can do this manually by placing the tag [code] at the start of the line, and the tag [/code] at the end.

Sincerely,
Leith Ross

[Solarissf]

thank you
problem explained alittle more.
In Case 4 I have 4 emails it should goto, and it does.
In Case 5, I have 3 emails, but the macro is still emailing to 4 people, and it seems that it picks a random person. Can someone please help me to figure out why it is emailing extra people?

THANKS!!!

Option Explicit
Sub pivottable1()

Dim oSess As Object
Dim oDB As Object
Dim oDoc As Object
Dim oItem As Object
Dim direct As Object
Dim Var As Variant
Dim flag As Boolean
Dim sSetWbName As String
Dim pvtField As PivotField
Dim pvtItem As PivotItem
Dim strAccount As String
Dim X As Integer
Dim Counter As Integer
Dim cust(50) As String

Application.DisplayAlerts = False

      


    Windows("sending first notice days.xls").Activate
    Sheets("Notice").Select
 

 
  
For X = 1 To 9
 

' Creates a pivot table
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        "Notice!R1C1:R5000C11").CreatePivotTable TableDestination:="", TableName:= _
        "PivotTabletest", DefaultVersion:=xlPivotTableVersion10
    ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(1, 1)
    ActiveSheet.Cells(1, 1).Select
    
    
' Populates pivot table with headers and data
    With ActiveSheet.PivotTables("PivotTabletest").PivotFields("Account")
        .Orientation = xlRowField
        .Position = 1
    End With
        
    Set pvtField = ActiveSheet.PivotTables("PivotTabletest").PivotFields("Account")
    
          

            Select Case X
                Case 1: strAccount = "0LC 914598"
                    cust(0) = "xxx.com"
                    cust(1) = "xxx.com"
                    cust(2) = "xxx.com"
                Case 2: strAccount = "0LC 915578":
                    cust(0) = "xxx.com"
                    cust(1) = "xxx.com"
                    cust(2) = "xxx.com"
                Case 3: strAccount = "0LC 915594"
                    cust(0) = "xxx.com"
                    cust(1) = "xxx.com"
                    cust(2) = "xxx.com"
                Case 4: strAccount = "0LC 915586"
                    cust(0) = "xxx.com"
                    cust(1) = "xxx.com"
                    cust(2) = "xxx.net"
                    cust(3) = "xxx.com"
                Case 5: strAccount = "0LC 915608"
                    cust(0) = "xxx.com"
                    cust(1) = "xxx.com"
                    cust(2) = "xxx.com"
                    cust(3) = "xxx.com"
                Case 6: strAccount = "0LC 915560"
                    cust(0) = "xxx.com"
                    cust(1) = "xxx.com"
                Case 7: strAccount = "0LC 915632"
                    cust(0) = "xxx.com"
                    cust(1) = "xxx.com"
                Case 8: strAccount = "0LC 914768"
                    cust(0) = "xxx.com"
                    cust(1) = "xxx.com"
                    cust(2) = "xxx.com"
                Case 9: strAccount = "05A 000091"
                    cust(0) = "xxx.com"
                    cust(1) = "xxx.com"
                    
                
            End Select

    
                
                
                With pvtField
                    ' set to true first as at least 1 item must be visible to
                    ' avoid error
                    On Error Resume Next
                    .PivotItems(strAccount).Visible = True
                    For Each pvtItem In .PivotItems
                        pvtItem.Visible = pvtItem.Value = strAccount

                    Next
                End With
                
 
  
    
    With ActiveSheet.PivotTables("PivotTabletest").PivotFields("Early Notice")
        .Orientation = xlRowField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("PivotTabletest").PivotFields("Commodity")
        .Orientation = xlRowField
        .Position = 3
    End With
    With ActiveSheet.PivotTables("PivotTabletest").PivotFields("Delivery Date")
        .Orientation = xlRowField
        .Position = 4
    End With
    With ActiveSheet.PivotTables("PivotTabletest").PivotFields("Strike")
        .Orientation = xlRowField
        .Position = 5
    End With
    With ActiveSheet.PivotTables("PivotTabletest").PivotFields("Side")
        .Orientation = xlRowField
        .Position = 6
    End With
    With ActiveSheet.PivotTables("PivotTabletest").PivotFields("Quantity")
        .Orientation = xlRowField
        .Position = 7
    End With
    With ActiveSheet.PivotTables("PivotTabletest").PivotFields("Lst Trd Date")
        .Orientation = xlRowField
        .Position = 8
    End With
    With ActiveSheet.PivotTables("PivotTabletest").PivotFields("1st Notice Date")
        .Orientation = xlRowField
        .Position = 9
    End With
    With ActiveSheet.PivotTables("PivotTabletest").PivotFields("Currency")
        .Orientation = xlRowField
        .Position = 10
    End With
    



' Removes total sections from pivot table
    For Counter = 1 To 10
    
        Cells.Find(What:="total", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
            False, SearchFormat:=False).Activate
        Selection.Delete
    
    Next Counter
    

    
    
' Formats sheet and adds logos to sheet that go to customer

    
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("K:K").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
    
    Cells.Select
        With Selection.Interior
            .ColorIndex = 2
            .Pattern = xlSolid
        End With
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Font.Bold = True
    Selection.Interior.ColorIndex = 6
    Range("A1").Select
    

    
    Sheets(1).Select
    Cells.Select
    Selection.Copy
    Workbooks.Add
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Documents and Settings\x152169\Desktop\FirstNotice.xls", FileFormat:=xlNormal _
        , Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
        
    

    Windows("FirstNotice.xls").Activate
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Selection.Insert Shift:=xlDown
    Windows("sending first notice days.xls").Activate
    Sheets("format").Select
    ActiveSheet.Shapes("Picture 2").Select
    Selection.Copy
    Windows("FirstNotice.xls").Activate
    Range("A1").Select
    ActiveSheet.Paste
    Windows("sending first notice days.xls").Activate
    Sheets("format").Select
    Range("A10:A11").Select
    Selection.Copy
    Windows("FirstNotice.xls").Activate
    Range("C7").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(2, 0).Select
    Selection.End(xlToLeft).Select
    ActiveSheet.Paste
    Columns("D:D").Select
    Selection.NumberFormat = "[$-409]mmm-yy;@"
    Range("A1").Select
    
        ActiveWorkbook.SaveAs Filename:= _
        "C:\Documents and Settings\x152169\Desktop\FirstNotice.xls", FileFormat:=xlNormal _
        , Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
        

    'Starts process to email sheet to client
        
    Set oSess = CreateObject("Notes.NotesSession")
    Set oDB = oSess.GETDATABASE("", "")
    Call oDB.OPENMAIL
    flag = True
    If Not (oDB.IsOpen) Then flag = oDB.Open("", "")
    
    If Not flag Then
    MsgBox "Can't open mail file: " & oDB.SERVER & " " & oDB.FILEPATH
    GoTo exit_SendAttachment
    End If

    
    If Range("A8") <> "(blank)" Then

    
    ' EMAIL ADDRESS FILES ARE SENT TO  *************************************************
    'Building Message
    Set oDoc = oDB.CREATEDOCUMENT
    Set oItem = oDoc.CREATERICHTEXTITEM("BODY")
    oDoc.Form = "Memo"
    oDoc.Subject = "Test Automatic First Notice Emails"
    oDoc.sendto = cust
    oDoc.body = "Please let me know if something does not look correct, including email addresses.  Thank You"
    oDoc.postdate = Date
    oDoc.SaveMessageOnSend = True
    
    'Attaching DATABASE
    
    sSetWbName = ActiveWorkbook.FullName
    Call oItem.EmbedObject(1454, "", sSetWbName)
    oDoc.visable = True
    
    'Sending Message
    oDoc.SEND False
exit_SendAttachment:
    On Error Resume Next
    Set oSess = Nothing
    Set oDB = Nothing
    Set oDoc = Nothing
    Set oItem = Nothing
    'Done
    
    'deletes temporary file
    ActiveWorkbook.Close
    Kill ("C:\Documents and Settings\x152169\Desktop\FirstNotice.xls")
    
    Windows("sending first notice days.xls").Activate
    Sheets(1).Select
    ActiveWindow.SelectedSheets.Delete


    
    Else
        ActiveWorkbook.Close
    Kill ("C:\Documents and Settings\x152169\Desktop\FirstNotice.xls")
    
    Windows("sending first notice days.xls").Activate
    Sheets(1).Select
    ActiveWindow.SelectedSheets.Delete
    
    End If
    
    Next X

    Application.DisplayAlerts = True
    
    
    
End Sub