How can I delete an item from an array?

Question

I have an Excel file that contains contact email addresses, such as the below.

      A        B                     C
1     Shop     Supervisor            Assistant
2     A        hulk.hogan@web.com    freddie.mercury@web.com
3     B                              brian.may@web.com
4     C        triple.h@web.com      roger.taylor@web.com
5     D        
6     E        randy.orton@web.com   john.deacom@web.com

I have created a userform where the user can select what role they want to email (Supervisor or Assistant) or they can email both if needed, and then there's code that takes the email addresses for those roles, opens a new email, and adds the email addresses into the "To" section. This code is as follows:

 Private Sub btnEmail_Click()
     Dim To_Recipients As String
     Dim NoContacts() As String
     Dim objOutlook As Object
     Dim objMail As Object
     Dim firstRow As Long
     Dim lastRow As Long

     ReDim NoContacts(1 To 1) As String

     ' Define the column variables
     Dim Supervisor_Column As String, Assistant_Column As String

     Set objOutlook = CreateObject("Outlook.Application")
     Set objMail = objOutlook.CreateItem(0)

     ' Add in the column references to where the email addresses are, e.g. Supervisor is in column K
     Supervisor_Column = "K"
     Assistant_Column = "M"

     ' Clear the To_Recipients string of any previous data
     To_Recipients = ""

     ' If the To Supervisor checkbox is ticked
     If chkToSupervisor.Value = True Then
         With ActiveSheet
             ' Get the first and last rows that can be seen with the filter
             firstRow = .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Row
             lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
             ' For every row between the first and last
             For Row = firstRow To lastRow
                 ' Check if the row is visible - i.e. if it is included in the filter
                 If Rows(Row).Hidden = False Then
                     ' If it is visible then check to see whether there is data in the cell
                     If Not IsEmpty(Range(Supervisor_Column & Row).Value) And Range(Supervisor_Column & Row).Value <> 0 Then
                         ' If there is data then add it to the list of To_Recipients
                         To_Recipients = To_Recipients & ";" & Range(Supervisor_Column & Row).Value
                     Else
                         ' See whether the shop is already in the array
                         If UBound(Filter(NoContacts, Range("F" & Row).Value)) = -1 Then
                             ' If it isn't then add it to the array
                             NoContacts(UBound(NoContacts)) = Range("F" & Row).Value
                             ReDim Preserve NoContacts(1 To UBound(NoContacts) + 1) As String
                         End If
                     End If
                 End If
             ' Go onto the next row
             Next Row
         End With
     End If

     ' If the To Assistant checkbox is ticked
     If chkToAssistant.Value = True Then
         With ActiveSheet
             ' Get the first and last rows that can be seen with the filter
             firstRow = .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Row
             lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
             ' For every row between the first and last
             For Row = firstRow To lastRow
                  ' Check if the row is visible - i.e. if it is included in the filter
                  If Rows(Row).Hidden = False Then
                     ' If it is visible then check to see whether there is data in the cell
                     If Not IsEmpty(Range(Assistant_Column & Row).Value) And Range(Assistant_Column & Row).Value <> 0 Then
                         ' If there is data then add it to the list of To_Recipients
                         To_Recipients = To_Recipients & ";" & Range(Assistant_Column & Row).Value
                     Else
                         ' See whether the shop is already in the array
                         If UBound(Filter(NoContacts, Range("F" & Row).Value)) = -1 Then
                             ' If it isn't then add it to the array
                             NoContacts(UBound(NoContacts)) = Range("F" & Row).Value
                             ReDim Preserve NoContacts(1 To UBound(NoContacts) + 1) As String
                         End If
                     End If
                 End If
             ' Go onto the next row
             Next Row
         End With
     End If


     With objMail
         .To = To_Recipients
         .Display
     End With


     Set objOutlook = Nothing
     Set objMail = Nothing

     ' Close the User Form
     Unload Me
 End Sub

What I want to be able to do is get is so that if there isn't a contact, for example in shop "D" in the above example, a message box appears saying that there is no contact. To do this I have started to use the array:

NoContacts

Which, as you can see in the code from the above:

' See whether the shop is already in the array
If UBound(Filter(NoContacts, Range("F" & Row).Value)) = -1 Then
     ' If it isn't then add it to the array
     NoContacts(UBound(NoContacts)) = Range("F" & Row).Value
     ReDim Preserve NoContacts(1 To UBound(NoContacts) + 1) As String
End if

Has the shop letter entered into it if there isn't a contact, for example if there isn't a Supervisor like shop "B" in the example. Because this code looks at all the Supervisors, i.e. it runs down column B adding the email addresses to the "To_Recipients" variable if there is an email address and adding the shop to the "NoContacts" array if there isn't, then goes on to the Assistants, I need to know how to delete an item from the array.

For example, the above code will add Shop "B" into the array because it doesn't have a Supervisor, however because it has an Assistant I need to remove Shop "B" from the array when it runs the Assistant code, whereas Shop "D" will stay in the array because it has neither Supervisor or Assistant - Remember that I am trying to display a list of Shops that have no contact and so are not included in the email.

This are makes sense in my mind, however please let me know if I have not explained it clearly.

So, to clarify, how can I remove a specific item from an array?

Answer 1

Your code could be simplified by only looping over the rows once, and checking both supervisor and assistant at the same time:

Private Sub btnEmail_Click()

    'Add in the column references to where the email addresses are
    Const Supervisor_Column = "K"
    Const Assistant_Column = "M"

    Dim To_Recipients As String
    Dim NoContacts() As String
    Dim objOutlook As Object
    Dim objMail As Object
    Dim firstRow As Long, lastRow As Long
    Dim doSup As Boolean, doAssist  As Boolean, eSup, eAssist
    Dim bHadContact As Boolean

    ReDim NoContacts(1 To 1) As String

    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)

    doSup = chkToSupervisor.Value
    doAssist = chkToAssistant.Value


     To_Recipients = ""

     ' If either checkbox is ticked
     If doSup Or doAssist Then

         With ActiveSheet

             firstRow = .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Row
             lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row

             For Row = firstRow To lastRow
                 If Not Rows(Row).Hidden Then

                     bHadContact = False
                     eSup = Trim(.Cells(Row, Supervisor_Column))
                     eAssist = Trim(.Cells(Row, Assistant_Column))

                     If Len(eSup) > 0 And doSup Then
                        To_Recipients = To_Recipients & ";" & eSup
                        bHadContact = True
                     End If

                     If Len(eAssist) > 0 And doAssist Then
                        To_Recipients = To_Recipients & ";" & eAssist
                        bHadContact = True
                     End If

                     'no assistant or supervisor - add the shop
                     If Not bHadContact Then
                        NoContacts(UBound(NoContacts)) = .Cells(Row, "F").Value
                        ReDim Preserve NoContacts(1 To UBound(NoContacts) + 1)
                     End If

                 End If 'not hidden
             Next Row
         End With
     End If

     With objMail
         .To = To_Recipients
         .Display
     End With

     If UBound(NoContacts) > 1 Then
        MsgBox "One or more stores had no contacts:" & vbCrLf & Join(NoContacts, vbLf), _
                 vbExclamation
     End If

     Set objOutlook = Nothing
     Set objMail = Nothing

     ' Close the User Form
     Unload Me
 End Sub

To answer your specific question though, there's no built-in way to remove one or more items from an array. You would build a function or sub to do that: loop over the array and copy its items to a second array, excluding the item(s) to be removed.

Example:

Sub Tester()
    Dim arr
    arr = Split("A,B,C,D", ",")
    Debug.Print "Before:", Join(arr, ",")

    RemoveItem arr, "A"

    Debug.Print "After:", Join(arr, ",")
End Sub

Sub RemoveItem(ByRef arr, v)
    Dim rv(), i As Long, n As Long, ub As Long, lb As Long
    lb = LBound(arr): ub = UBound(arr)
    ReDim rv(lb To ub)
    For i = lb To ub
        If arr(i) <> v Then
            rv(i - n) = arr(i)
        Else
            n = n + 1
        End If
    Next
    'check bounds before resizing
    If (ub - n) >= lb Then ReDim Preserve rv(lb To ub - n)
    arr = rv
End Sub