isValidEmail but two in field problem

**Ruegen** · 12-02-2014, 09:22 PM

eep

for got a few things

improved and working

Code:

'cuts up the string into an array depending on the number of characters you want
Function sliceCharByNum(FullString As String, NumberOfCharacters As Long) As String()


If NumberOfCharacters <= 0 Then
Dim arrEmptyNum() As String
ReDim arrEmptyNum(0 To 0) As String
arrEmptyNum(0) = FullString
sliceCharByNum = arrEmptyNum()
Exit Function
End If


If Len(FullString) = 0 Then
Dim arrEmpty() As String
ReDim arrEmpty(0 To 0) As String
arrEmpty(0) = FullString
sliceCharByNum = arrEmpty()
Exit Function
Else


Dim SliceByNum As Long, CurrentVal As Long, i As Long
Dim strText As String, strImportedText As String
Dim arr() As String
ReDim arr(0 To 0) As String


NumFrom = Len(FullString)
SliceByNum = IIf(NumberOfCharacters = 0, 1, NumberOfCharacters)
strImportedText = FullString


CurrentVal = Len(strImportedText)
i = 0
Do Until strImportedText = ""


If Len(strImportedText) < NumberOfCharacters Then


ReDim Preserve arr(0 To i) As String
arr(i) = strImportedText
strImportedText = ""


Else


strText = ""
strText = Left(strImportedText, NumberOfCharacters)


CurrentVal = CurrentVal - NumberOfCharacters


strImportedText = Right(strImportedText, CurrentVal)




ReDim Preserve arr(0 To i) As String
arr(i) = strText
i = i + 1
End If


Loop
End If
sliceCharByNum = arr()


End Function

**Ruegen** · 12-02-2014, 09:43 PM

updated to allow the array to be decremented

Code:


'cuts up the string into an array depending on the number of characters you want
Function sliceCharByNum(FullString As String, NumberOfCharacters As Long, Descending As Boolean) As String()


If NumberOfCharacters <= 0 Then
Dim arrEmptyNum() As String
ReDim arrEmptyNum(0 To 0) As String
arrEmptyNum(0) = FullString
sliceCharByNum = arrEmptyNum()
Exit Function
End If


If Len(FullString) = 0 Then
Dim arrEmpty() As String
ReDim arrEmpty(0 To 0) As String
arrEmpty(0) = FullString
sliceCharByNum = arrEmpty()
Exit Function
Else


Dim SliceByNum As Long, CurrentVal As Long, i As Long
Dim strText As String, strImportedText As String
Dim arr() As String
ReDim arr(0 To 0) As String


NumFrom = Len(FullString)
SliceByNum = IIf(NumberOfCharacters = 0, 1, NumberOfCharacters)
strImportedText = FullString


CurrentVal = Len(strImportedText)
i = 0
Do Until strImportedText = ""


If Len(strImportedText) < NumberOfCharacters Then


ReDim Preserve arr(0 To i) As String
arr(i) = strImportedText
strImportedText = ""


Else


strText = ""
strText = Left(strImportedText, NumberOfCharacters)


CurrentVal = CurrentVal - NumberOfCharacters


strImportedText = Right(strImportedText, CurrentVal)




ReDim Preserve arr(0 To i) As String
arr(i) = strText
i = i + 1
End If


Loop
End If




If Descending = True Then


Dim Temp As Variant
Dim Ndx As Long
Dim Ndx2 As Long


Ndx2 = UBound(arr)
For Ndx = LBound(arr) To ((UBound(arr) - LBound(arr) + 1) \ 2)
    'swap the elements
    Temp = arr(Ndx)
    arr(Ndx) = arr(Ndx2)
    arr(Ndx2) = Temp
    ' decrement the upper index
    Ndx2 = Ndx2 - 1
Next Ndx


sliceCharByNum = arr()
Else
sliceCharByNum = arr()
End If


End Function

**Ruegen** · 12-02-2014, 09:45 PM

So basically if you set the function to 1 it will loop through a string and collect each character in an array then you can loop through the array and count the number of matching symbol characters like say @

**Ruegen** · 12-02-2014, 10:06 PM

OK got this working code for all below

Code:




'cuts up the string into an array depending on the number of characters you want
Function sliceCharByNum(FullString As Variant, NumberOfCharacters As Long, Descending As Boolean) As String()


If NumberOfCharacters <= 0 Then
Dim arrEmptyNum() As String
ReDim arrEmptyNum(0 To 0) As String
arrEmptyNum(0) = FullString
sliceCharByNum = arrEmptyNum()
Exit Function
End If


If Len(FullString) = 0 Then
Dim arrEmpty() As String
ReDim arrEmpty(0 To 0) As String
arrEmpty(0) = FullString
sliceCharByNum = arrEmpty()
Exit Function
Else


Dim SliceByNum As Long, CurrentVal As Long, i As Long
Dim strText As String, strImportedText As String
Dim arr() As String
ReDim arr(0 To 0) As String


'NumFrom = Len(FullString)
SliceByNum = IIf(NumberOfCharacters = 0, 1, NumberOfCharacters)
strImportedText = Nz(FullString, "")


CurrentVal = Len(strImportedText)
i = 0
Do Until strImportedText = ""


If Len(strImportedText) < NumberOfCharacters Then


ReDim Preserve arr(0 To i) As String
arr(i) = strImportedText
strImportedText = ""


Else


strText = ""
strText = Left(strImportedText, NumberOfCharacters)


CurrentVal = CurrentVal - NumberOfCharacters


strImportedText = Right(strImportedText, CurrentVal)




ReDim Preserve arr(0 To i) As String
arr(i) = strText
i = i + 1
End If


Loop
End If




If Descending = True Then


Dim Temp As Variant
Dim Ndx As Long
Dim Ndx2 As Long


Ndx2 = UBound(arr)
For Ndx = LBound(arr) To ((UBound(arr) - LBound(arr) + 1) \ 2)
    'swap the elements
    Temp = arr(Ndx)
    arr(Ndx) = arr(Ndx2)
    arr(Ndx2) = Temp
    ' decrement the upper index
    Ndx2 = Ndx2 - 1
Next Ndx


sliceCharByNum = arr()
Else
sliceCharByNum = arr()
End If


End Function

and the match by counting

Code:


'counts the number of matches of a string in an array that has one character per key
Function countMatchChar(ByRef arrayImport() As String, StringToMatch As Variant) As Long


Dim MatchString As String
Dim x As Long
Dim y As Long


MatchString = Nz(StringToMatch, "")
y = 0


For x = LBound(arrayImport) To UBound(arrayImport) 'define start and end of array


    If InStr(1, arrayImport(x), MatchString, vbTextCompare) > 0 Then
    y = y + 1
    End If


Next x


countMatchChar = y


End Function

You could of course combine the two into one too but I figure I will post that later after this.

**jas0501** · 12-02-2014, 11:28 PM

Code:

Option Compare Database
Option Explicit

Dim emailAddresses()        As String

Sub getEmailAddresses(src As String, separator as string)
Dim i As IntegeremailAddresses = Split(src, separator)
    
Debug.Print "============="
Debug.Print "There are " & UBound(emailAddresses) + 1; " addresses:"
For i = 0 To UBound(emailAddresses)
Debug.Print i + 1 & ". " & emailAddresses(i)
Next i
Debug.Print "============="End Sub




Sub test()
Dim src As String

src = "name1@company1.com"
getEmailAddresses src, " "

src = "name2.name3@company2.com;name4@company3.com;first.middle.lastname@company.net"
getEmailAddresses src, ";"
End Sub

Running test() produces:

=============
There are 1 addresses:
1. name1@company1.com
=============
=============
There are 3 addresses:
1. name2.name3@company2.com
2. name4@company3.com
3. first.middle.lastname@company.net
=============

**Ruegen** · 12-03-2014, 10:59 PM

Originally Posted by jas0501

Code:

Option Compare Database
Option Explicit

Dim emailAddresses()        As String

Sub getEmailAddresses(src As String, separator as string)
Dim i As IntegeremailAddresses = Split(src, separator)
    
Debug.Print "============="
Debug.Print "There are " & UBound(emailAddresses) + 1; " addresses:"
For i = 0 To UBound(emailAddresses)
Debug.Print i + 1 & ". " & emailAddresses(i)
Next i
Debug.Print "============="End Sub




Sub test()
Dim src As String
src = "name1@company1.com"
getEmailAddresses src, " "

src = "name2.name3@company2.com;name4@company3.com;first.middle.lastname@company.net"
getEmailAddresses src, ";"
End Sub

Running test() produces:

=============
There are 1 addresses:
1. name1@company1.com
=============
=============
There are 3 addresses:
1. name2.name3@company2.com
2. name4@company3.com
3. first.middle.lastname@company.net
=============

It's a nice checker but I will go with what I have written. I can count the number of matches or get a boolean result if I convert the function to return a true or false. It gives me more options.

**drexasaurus** · 12-04-2014, 10:47 AM

Originally Posted by pbaldy

I don't think it's that hard to loop a string, but I suppose it depends on what you're trying to do. I've got a function to get rid of special characters and it can't be more than 8-10 lines (For/Next loop and the Len() and Mid() function are the key components).

Also, testing for how many of a certain character there are in a string can be done without looping and storing positions; think creative use of the Len() and Replace() functions.

Meh, I guess it's not "hard", but since it's done entirely different that you'd loop through any other collection of things in vba, it's not intuitive--and that leads to accidental bugs, or at least minor irritation. :P

Ruegen: Cool work. Thanks for sharing.

**jas0501** · 12-05-2014, 04:54 PM

Originally Posted by Ruegen

It's a nice checker but I will go with what I have written. I can count the number of matches or get a boolean result if I convert the function to return a true or false. It gives me more options.

Code:


count = UBound(emailAddresses)+1

If count = 1 then
    validEmailAddr = true
else
    validEmailAddr = false
endif

**Ruegen** · 12-05-2014, 05:55 PM

Originally Posted by jas0501

Code:


count = UBound(emailAddresses)+1

If count = 1 then
    validEmailAddr = true
else
    validEmailAddr = false
endif

Hey thanks

I'll combine and use that one (it's faster than what I had in mind) and then post them on my website down the track

**Ruegen** · 12-07-2014, 03:44 PM

Of course there is always the simpler option...

Code:

'counts the number of matches of a string
Public Function CountChr(StringToSearch As Variant, StringToFind As String) As Long


If IsNull(StringToSearch) Then
StringToSearch = ""
End If


StringToSearch = Trim(CStr(StringToSearch))


    CountChr = UBound(Split(StringToSearch, StringToFind))


End Function

isValidEmail but two in field problem

Thread Tools

Here is my take using split and passing the separator

Similar Threads

I have a number field Problem!

Problem in the field of currency

Excel Import field truncation problem (to Access Memo field)

Field Name problem

Field ID Problem

Posting Permissions