Excel VBA Type Mismatch (13)

I get a type mismatch error in VBA, and I'm not sure why.

The purpose of this macro is to go through a column in an Excel spreadsheet and add all the emails to the array. After each email is added to the first array, it must also be added to the second array, but split in two by the @ symbol to separate the name from the domain. For example: person@gmail.com to person and gmail.com .

The problem I get is that when it comes to the point where the email is supposed to be split, it throws a type mismatch error.

In particular, this part:

strDomain = Split(strText, "@")

Here is the complete code:

 Sub addContactListEmails() Dim strEmailList() As String 'Array of emails Dim blDimensioned As Boolean 'Is the array dimensioned? Dim strText As String 'To temporarily hold names Dim lngPosition As Long 'Counting Dim strDomainList() As String Dim strDomain As String Dim dlDimensioned As Boolean Dim strEmailDomain As String Dim i As Integer Dim countRows As Long 'countRows = Columns("E:E").SpecialCells(xlVisible).Rows.Count countRows = Range("E:E").CurrentRegion.Rows.Count MsgBox "The number of rows is " & countRows 'The array has not yet been dimensioned: blDimensioned = False Dim counter As Long Do While counter < countRows counter = counter + 1 ' Set the string to the content of the cell strText = Cells(counter, 5).Value If strText <> "" Then 'Has the array been dimensioned? If blDimensioned = True Then 'Yes, so extend the array one element large than its current upper bound. 'Without the "Preserve" keyword below, the previous elements in our array would be erased with the resizing ReDim Preserve strEmailList(0 To UBound(strEmailList) + 1) As String Else 'No, so dimension it and flag it as dimensioned. ReDim strEmailList(0 To 0) As String blDimensioned = True End If 'Add the email to the last element in the array. strEmailList(UBound(strEmailList)) = strText 'Also add the email to the separation array strDomain = Split(strText, "@") If strDomain <> "" Then If dlDimensioned = True Then ReDim Preserve strDomainList(0 To UBound(strDomainList) + 1) As String Else ReDim strDomainList(0 To 0) As String dlDimensioned = True End If strDomainList(UBound(strDomainList)) = strDomain End If End If Loop 'Display email addresses, TESTING ONLY! For lngPosition = LBound(strEmailList) To UBound(strEmailList) MsgBox strEmailList(lngPosition) Next lngPosition For i = LBound(strDomainList) To UBound(strDomainList) MsgBox strDomainList(strDomain) Next 'Erase array 'Erase strEmailList End Sub 
+4
source share
5 answers

ReDim ing arrays is a big problem. Welcome to the world of collection and Dictionary s. Collection objects are always available. Dictionaries require a link to the Microsoft Scripting Runtime (Tools> Links> scroll down to find this text and check the box> OK). They dynamically change the size for you, you can add, delete elements very easily compared to arrays, and dictionaries specifically allow you to organize your data in a more logical way.

In the code below, I used the dictionary where the key is the domain (obtained using the split function). Each value for a key is a set of email addresses with this domain.

Place a breakpoint on the End Sub and view the contents of each of these objects in your locals window. I think you will see that they make more sense and are easier on the whole.

Explicit option

 Function AllEmails() As Dictionary Dim emailListCollection As Collection Set emailListCollection = New Collection 'you're going to like collections way better than arrays Dim DomainEmailDictionary As Dictionary Set DomainEmailDictionary = New Dictionary 'key value pairing. key is the domain. value is a collection of emails in that domain Dim emailParts() As String Dim countRows As Long Dim EmailAddress As String Dim strDomain As String 'countRows = Columns("E:E").SpecialCells(xlVisible).Rows.Count Dim sht As Worksheet 'always declare your sheets! Set sht = Sheets("Sheet1") countRows = sht.Range("E2").End(xlDown).Row Dim counter As Long Do While counter < countRows counter = counter + 1 EmailAddress = Trim(sht.Cells(counter, 5)) If EmailAddress <> "" Then emailParts = Split(EmailAddress, "@") If UBound(emailParts) > 0 Then strDomain = emailParts(1) End If If Not DomainEmailDictionary.Exists(strDomain) Then 'if you have not already encountered this domain DomainEmailDictionary.Add strDomain, New Collection End If 'Add the email to the dictionary of emails organized by domain DomainEmailDictionary(strDomain).Add EmailAddress 'Add the email to the collection of only addresses emailListCollection.Add EmailAddress End If Loop Set AllEmails = DomainEmailDictionary End Function 

and use it with

 Sub RemoveUnwantedEmails() Dim allemailsDic As Dictionary, doNotCallSheet As Worksheet, emailsSheet As Worksheet Set doNotCallSheet = Sheets("DoNotCallList") Set emailsSheet = Sheets("Sheet1") Set allemailsDic = AllEmails Dim domain As Variant, EmailAddress As Variant Dim foundDoNotCallDomains As Range, emailAddressesToRemove As Range For Each domain In allemailsDic.Keys Set foundDoNotCallDomains = doNotCallSheet.Range("A:A").Find(domain) If Not foundDoNotCallDomains Is Nothing Then Debug.Print "domain found" 'do your removal For Each EmailAddress In allemailsDic(domain) Set emailAddressesToRemove = emailsSheet.Range("E:E").Find(EmailAddress) If Not emailAddressesToRemove Is Nothing Then emailAddressesToRemove = "" End If Next EmailAddress End If Next domain End Sub 
+5
source

strDomain must store an array of split text, so

 Dim strDomain As Variant 

Subsequently, strDomain must reference the index if operations with certain fragments are performed:

 If strDomain(i) <> "" Then 
+4
source

The split function returns an array of strings based on the provided delimiter.

In your case, if you are sure that the source line is an email with only one "@" in it, you can safely use the code below:

 strDomain = Split(strText, "@")(1) 

This will give you the part after the "@" you are looking for.

+2
source

Split returns an array:

 Dim mailComp() As String [...] mailComp = Split(strText, "@") strDomain = mailComp(1) 
+1
source

Try strDomain = Split(strText,"@")(1) to get the right side of the split, where (0) will be left. And, of course, works with more than two splits. You can flatten the string variable as an strDomain() array, and then Split(strText,"@") will put all the selected text into an array.

+1
source

Source: https://habr.com/ru/post/1444917/


All Articles