Random email string

[pjbltd]

Hi,

In an excel file I have a list of email addresses in column A (5,000+ addresses).
I want to create a macro that will pick a random selection of 100 of these, then concantenate into an string seperated by semi colon and space e.g. "xxx@yyy.com; zzz@bbb.com".

Any advice the best way to do this?

Thanks,
pjbltd

 

[shg]

One way:

	A​	B​	C​	D​
1​	Choose​	5​		B1: Input
2​	Out of​	20​		B2: =ROWS(A4:A23)
3​	eMail​	Choose?​
4​	1@aol.com	0​	2@aol.com;5@aol.com;16@aol.com;18@aol.com;19@aol.com	B4: =--(RAND() < ($B$1 - SUM(B$3:B3)) / (B$2 - ROWS(B$3:B4) + 2))
5​	2@aol.com	1​		C4: =catIf(B4:B23, A4:A23, ";")
6​	3@aol.com	0​
7​	4@aol.com	0​
8​	5@aol.com	1​
9​	6@aol.com	0​
10​	7@aol.com	0​
11​	8@aol.com	0​
12​	9@aol.com	0​
13​	10@aol.com	0​
14​	11@aol.com	0​
15​	12@aol.com	0​
16​	13@aol.com	0​
17​	14@aol.com	0​
18​	15@aol.com	0​
19​	16@aol.com	1​
20​	17@aol.com	0​
21​	18@aol.com	1​
22​	19@aol.com	1​
23​	20@aol.com	0​

Function CatIf(avbIf As Variant, _
               rInp As Range, _
               Optional sSep As String = ",", _
               Optional bCatEmpty As Boolean = False) As String
  ' shg 2007
  ' UDF only

  ' Catenates the elements of rInp separated by sSep where the corresponding
  ' element of avbIf is True. Empty cells ignored unless bCatEmpty is True.

  Dim iRow          As Long
  Dim iCol          As Long
  Dim i             As Long

  On Error Resume Next
  i = UBound(avbIf, 2)

  If Err.Number Then
    ' avbIf is 1D
    For iRow = 1 To rInp.Rows.Count
      For iCol = 1 To rInp.Columns.Count
        i = i + 1
        If avbIf(i) Then
          If bCatEmpty Or Not IsEmpty(rInp(iRow, iCol).Value2) Then
            CatIf = CatIf & rInp(iRow, iCol).Value2 & sSep
          End If
        End If
      Next iCol
    Next iRow
  Else
    ' it's 2D
    For iRow = 1 To rInp.Rows.Count
      For iCol = 1 To rInp.Columns.Count
        If avbIf(iRow, iCol) Then
          If bCatEmpty Or Not IsEmpty(rInp(iRow, iCol).Value2) Then
            CatIf = CatIf & rInp(iRow, iCol).Value2 & sSep
          End If
        End If
      Next iCol
    Next iRow
  End If

  If Len(CatIf) Then CatIf = Left(CatIf, Len(CatIf) - Len(sSep))
End Function