How can I delete an item from an array? - arrays

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