Excel VBA loop list
I need to automatically generate a random list of participants from a list that will vary in length. I would like to get help with all/part of this process, having problem starting in new Office 2007.
The attachment shows a sample of the list. It will be much longer in actuality.
My button must create a random list of participants on second tab "List".
It needs to:
1. Loop through each GROUP and choose one participant from each.
Paste entire row to make new list on LIST tab.
2. Vary in tenure - if GROUP 1 participant is TENURE CODE 1, others should be 2, 3...
(Only 1,2,3 should be used.)
3. Only use participants who have not participated yet. The TERM column would be blank. I will need to have it enter the date in that column if the member is going on the lists, so that for future lists, they are not chosen again.
Thanks!
Sample.xls
The attachment shows a sample of the list. It will be much longer in actuality.
My button must create a random list of participants on second tab "List".
It needs to:
1. Loop through each GROUP and choose one participant from each.
Paste entire row to make new list on LIST tab.
2. Vary in tenure - if GROUP 1 participant is TENURE CODE 1, others should be 2, 3...
(Only 1,2,3 should be used.)
3. Only use participants who have not participated yet. The TERM column would be blank. I will need to have it enter the date in that column if the member is going on the lists, so that for future lists, they are not chosen again.
Thanks!
Sample.xls
An other one
You have groups 1 to 9 and tenure from 1 to 3 and you mention 1 per group and tenure 1,2,3 this mean you only need 3 names per run (say group1 Tenure 3, group 2 Tenure 2 and group 4 tenure1) ? or I am missing something ?
gowflow
You have groups 1 to 9 and tenure from 1 to 3 and you mention 1 per group and tenure 1,2,3 this mean you only need 3 names per run (say group1 Tenure 3, group 2 Tenure 2 and group 4 tenure1) ? or I am missing something ?
gowflow
Hi,
May be...
Sub kTest()
Dim ka, k(), i As Long, n As Long, c As Long
Dim eList As Object, nList As Object
Dim wksAll As Worksheet, wksList As Worksheet
Dim blnListExists As Boolean, strConcat As String
Const gCode As String = "Group"
Const tCode As String = "Tenture"
Set wksAll = Worksheets("All Participants")
Set wksList = Worksheets("List")
Set nList = CreateObject("scripting.di
nList.comparemode = 1
blnListExists = Application.WorksheetFunct
If blnListExists Then
Set eList = CreateObject("scripting.di
eList.comparemode = 1
ka = wksList.UsedRange.Resize(,
For i = 2 To UBound(ka, 1)
strConcat = vbNullString
For c = 1 To UBound(ka, 2)
If IsDate(ka(i, c)) Then
strConcat = strConcat & "," & CDate(ka(i, c))
Else
strConcat = strConcat & "," & Trim$(CStr(ka(i, c)))
End If
Next
eList.Item(strConcat) = Empty
Next
End If
ka = wksAll.UsedRange
ReDim k(1 To 3, 1 To UBound(ka, 2))
For i = 2 To UBound(ka, 1)
If Len(ka(i, 1)) Then
strConcat = vbNullString
For c = 1 To UBound(ka, 2)
If IsDate(ka(i, c)) Then
strConcat = strConcat & "," & CDate(ka(i, c))
Else
strConcat = strConcat & "," & Trim$(CStr(ka(i, c)))
End If
Next
If blnListExists Then
If Not eList.exists(strConcat) Then
StartAgain:
If Not nList.exists(tCode & ka(i, 6)) Then
If Not nList.exists(strConcat) Then
nList.Add tCode & ka(i, 6), Nothing
nList.Add strConcat, Nothing
nList.Add gCode & ka(i, 1), Nothing
n = n + 1
For c = 1 To UBound(ka, 2)
If IsDate(ka(i, c)) Then
k(n, c) = CDate(ka(i, c))
Else
k(n, c) = Trim$(CStr(ka(i, c)))
End If
Next
If n = 3 Then Exit For
End If
End If
End If
Else
GoTo StartAgain
End If
End If
Next
If n = 3 Then
With wksList
If Not blnListExists Then
.Cells(1).Resize(, UBound(ka, 2)) = wksAll.UsedRange.Rows(1).R
End If
.Range("a" & .Rows.Count).End(xlUp).Off
End With
End If
End Sub
Kris
May be...
Sub kTest()
Dim ka, k(), i As Long, n As Long, c As Long
Dim eList As Object, nList As Object
Dim wksAll As Worksheet, wksList As Worksheet
Dim blnListExists As Boolean, strConcat As String
Const gCode As String = "Group"
Const tCode As String = "Tenture"
Set wksAll = Worksheets("All Participants")
Set wksList = Worksheets("List")
Set nList = CreateObject("scripting.di
nList.comparemode = 1
blnListExists = Application.WorksheetFunct
If blnListExists Then
Set eList = CreateObject("scripting.di
eList.comparemode = 1
ka = wksList.UsedRange.Resize(,
For i = 2 To UBound(ka, 1)
strConcat = vbNullString
For c = 1 To UBound(ka, 2)
If IsDate(ka(i, c)) Then
strConcat = strConcat & "," & CDate(ka(i, c))
Else
strConcat = strConcat & "," & Trim$(CStr(ka(i, c)))
End If
Next
eList.Item(strConcat) = Empty
Next
End If
ka = wksAll.UsedRange
ReDim k(1 To 3, 1 To UBound(ka, 2))
For i = 2 To UBound(ka, 1)
If Len(ka(i, 1)) Then
strConcat = vbNullString
For c = 1 To UBound(ka, 2)
If IsDate(ka(i, c)) Then
strConcat = strConcat & "," & CDate(ka(i, c))
Else
strConcat = strConcat & "," & Trim$(CStr(ka(i, c)))
End If
Next
If blnListExists Then
If Not eList.exists(strConcat) Then
StartAgain:
If Not nList.exists(tCode & ka(i, 6)) Then
If Not nList.exists(strConcat) Then
nList.Add tCode & ka(i, 6), Nothing
nList.Add strConcat, Nothing
nList.Add gCode & ka(i, 1), Nothing
n = n + 1
For c = 1 To UBound(ka, 2)
If IsDate(ka(i, c)) Then
k(n, c) = CDate(ka(i, c))
Else
k(n, c) = Trim$(CStr(ka(i, c)))
End If
Next
If n = 3 Then Exit For
End If
End If
End If
Else
GoTo StartAgain
End If
End If
Next
If n = 3 Then
With wksList
If Not blnListExists Then
.Cells(1).Resize(, UBound(ka, 2)) = wksAll.UsedRange.Rows(1).R
End If
.Range("a" & .Rows.Count).End(xlUp).Off
End With
End If
End Sub
Kris
ASKER
Kris, This is great! It chooses from Groups 1-3, could we get it to chose one participant from each Group 1-9? Thanks so much!!
ASKER
goflow,
I need to make a new list every 3 months. Ideally, I would like to add a date in the TERM column on the All Participants tab, which will eliminate them from being on the list the next time.
I would generate a new list every 3 months.
The list would be one participant from Group 1-9. Vary in Tenure where possible. Use only participants who have not participated yet.
So I would create the list, enter the date in the TERM column. Repeat after 3 month.
Hope this helps!
I need to make a new list every 3 months. Ideally, I would like to add a date in the TERM column on the All Participants tab, which will eliminate them from being on the list the next time.
I would generate a new list every 3 months.
The list would be one participant from Group 1-9. Vary in Tenure where possible. Use only participants who have not participated yet.
So I would create the list, enter the date in the TERM column. Repeat after 3 month.
Hope this helps!
Hi,
Like this ..?
Kris
Like this ..?
Kris
ASKER
Hi Kris, I don't see anything..?
Oh, sorry. I thought I attached the code.
Here you go..
Sub kTest()
Dim ka, k(), i As Long, n As Long, c As Long
Dim eList As Object, nList As Object
Dim wksAll As Worksheet, wksList As Worksheet
Dim blnListExists As Boolean, strConcat As String
Const gCode As String = "Group"
Const tCode As String = "Tenture"
Set wksAll = Worksheets("All Participants")
Set wksList = Worksheets("List")
Set nList = CreateObject("scripting.di
nList.comparemode = 1
blnListExists = Application.WorksheetFunct
If blnListExists Then
Set eList = CreateObject("scripting.di
eList.comparemode = 1
ka = wksList.UsedRange.Resize(,
For i = 2 To UBound(ka, 1)
strConcat = vbNullString
For c = 1 To UBound(ka, 2)
If IsDate(ka(i, c)) Then
strConcat = strConcat & "," & CDate(ka(i, c))
Else
strConcat = strConcat & "," & Trim$(CStr(ka(i, c)))
End If
Next
eList.Item(strConcat) = Empty
Next
End If
ka = wksAll.UsedRange
ReDim k(1 To 3, 1 To UBound(ka, 2))
For i = 2 To UBound(ka, 1)
If Len(ka(i, 1)) Then
strConcat = vbNullString
For c = 1 To UBound(ka, 2)
If IsDate(ka(i, c)) Then
strConcat = strConcat & "," & CDate(ka(i, c))
Else
strConcat = strConcat & "," & Trim$(CStr(ka(i, c)))
End If
Next
If blnListExists Then
If Not eList.exists(strConcat) Then
StartAgain:
If Not nList.exists(tCode & ka(i, 6)) Then
If Not nList.exists(strConcat) Then
If Not nList.exists(gCode & ka(i, 1)) Then
nList.Add tCode & ka(i, 6), Nothing
nList.Add strConcat, Nothing
nList.Add gCode & ka(i, 1), Nothing
n = n + 1
For c = 1 To UBound(ka, 2)
If IsDate(ka(i, c)) Then
k(n, c) = CDate(ka(i, c))
Else
k(n, c) = Trim$(CStr(ka(i, c)))
End If
Next
If n = 3 Then Exit For
End If
End If
End If
End If
Else
GoTo StartAgain
End If
End If
Next
If n = 3 Then
With wksList
If Not blnListExists Then
.Cells(1).Resize(, UBound(ka, 2)) = wksAll.UsedRange.Rows(1).R
End If
.Range("a" & .Rows.Count).End(xlUp).Off
End With
End If
End Sub
Kris
Euro5 let me know if u need help
gowflow
gowflow
ASKER
Still only generating list of 3 rather than one from each group. There should always be 9 participants.
Group Zip Owner Join Date Tenure Tenture Code Term Eligible?
1 14092 Arnold 1/3/1989 61mth+ 3 YES
2 14098 Hopston 8/20/2007 25-60mth 2 YES
3 14101 Houge 10/26/2009 6-24mth 1 YES
Group Zip Owner Join Date Tenure Tenture Code Term Eligible?
1 14092 Arnold 1/3/1989 61mth+ 3 YES
2 14098 Hopston 8/20/2007 25-60mth 2 YES
3 14101 Houge 10/26/2009 6-24mth 1 YES
OK. you have to run the macro 3 times. I'll modify the macro later this evening.
Kris
ASKER
ok, thanks goflow
If he doesn't fix it then i'll spend sometime on it. I will follow-it up
gowflow
gowflow
Hi,
Try this.
Kris
Try this.
Kris
Dim blnNoMoreList As Boolean
Sub RunAll()
blnNoMoreList = False
Do While Not blnNoMoreList
kTest
Loop
End Sub
Sub kTest()
Dim ka, k(), i As Long, n As Long, c As Long
Dim eList As Object, nList As Object
Dim wksAll As Worksheet, wksList As Worksheet
Dim blnListExists As Boolean, strConcat As String
Const gCode As String = "Group"
Const tCode As String = "Tenture"
Set wksAll = Worksheets("All Participants")
Set wksList = Worksheets("List")
Set nList = CreateObject("scripting.dictionary")
nList.comparemode = 1
blnListExists = Application.WorksheetFunction.CountA(wksList.UsedRange.Offset(1))
If blnListExists Then
Set eList = CreateObject("scripting.dictionary")
eList.comparemode = 1
ka = wksList.UsedRange.Resize(, 8)
For i = 2 To UBound(ka, 1)
strConcat = vbNullString
For c = 1 To UBound(ka, 2)
If IsDate(ka(i, c)) Then
strConcat = strConcat & "," & CDate(ka(i, c))
Else
strConcat = strConcat & "," & Trim$(CStr(ka(i, c)))
End If
Next
eList.Item(strConcat) = Empty
Next
End If
ka = wksAll.UsedRange
ReDim k(1 To 3, 1 To UBound(ka, 2))
For i = 2 To UBound(ka, 1)
If Len(ka(i, 1)) Then
strConcat = vbNullString
For c = 1 To UBound(ka, 2)
If IsDate(ka(i, c)) Then
strConcat = strConcat & "," & CDate(ka(i, c))
Else
strConcat = strConcat & "," & Trim$(CStr(ka(i, c)))
End If
Next
If blnListExists Then
If Not eList.exists(strConcat) Then
StartAgain:
If Not nList.exists(tCode & ka(i, 6)) Then
If Not nList.exists(strConcat) Then
If Not nList.exists(gCode & ka(i, 1)) Then
nList.Add tCode & ka(i, 6), Nothing
nList.Add strConcat, Nothing
nList.Add gCode & ka(i, 1), Nothing
n = n + 1
For c = 1 To UBound(ka, 2)
If IsDate(ka(i, c)) Then
k(n, c) = CDate(ka(i, c))
Else
k(n, c) = Trim$(CStr(ka(i, c)))
End If
Next
If n = 3 Then Exit For
End If
End If
End If
End If
Else
GoTo StartAgain
End If
End If
Next
If n = 3 Then
With wksList
If Not blnListExists Then
.Cells(1).Resize(, UBound(ka, 2)) = wksAll.UsedRange.Rows(1).Resize(, UBound(ka, 2)).Value
End If
.Range("a" & .Rows.Count).End(xlUp).Offset(1).Resize(3, UBound(ka, 2)).Value = k
End With
Else
blnNoMoreList = True
End If
End Sub
Euro5 I am not sure the last code is giving you what you want but anyway I let you comment
gowflow
gowflow
ASKER
gowflow,
Nope, it just gives me a list of 3.
Group Zip Owner Join Date Tenure Tenture Code Term Eligible?
1 14092 Arnold 1/3/1989 61mth+ 3 YES
2 14098 Hopston 8/20/2007 25-60mth 2 YES
3 14101 Houge 10/26/2009 6-24mth 1 YES
I need a list of 9, one from each group. Can you help??
The list must be
ELIGIBLE = YES
One participant from each group
Varied in Tenure as much as possible
Nope, it just gives me a list of 3.
Group Zip Owner Join Date Tenure Tenture Code Term Eligible?
1 14092 Arnold 1/3/1989 61mth+ 3 YES
2 14098 Hopston 8/20/2007 25-60mth 2 YES
3 14101 Houge 10/26/2009 6-24mth 1 YES
I need a list of 9, one from each group. Can you help??
The list must be
ELIGIBLE = YES
One participant from each group
Varied in Tenure as much as possible
I hope this is what your looking for.
Run it first time chkl results, run it again chk it again chk it ....
Let me know
gowflow
Sample.xls
Run it first time chkl results, run it again chk it again chk it ....
Let me know
gowflow
Sample.xls
ASKER
Will do, thanks!
Hi,
Run the macro 'RunAll' not the 'kTest'.
Kris
Run the macro 'RunAll' not the 'kTest'.
Kris
Euro5 did you try my solution ?
gowflow
gowflow
ASKER
Gowflow no access right now. Will try ASAP! Thanks so much.
No problem tke your time.
gowflow
gowflow
ASKER
I get message "List was created for 0 Groups".
Does not create a list at all.
I tried both 2003 & 2007 Excel. Wonder if I'm doing something wrong?
Does not create a list at all.
I tried both 2003 & 2007 Excel. Wonder if I'm doing something wrong?
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
gowflow - No, that was my fault, I should have seen that! Thanks so much, this is perfect!
ASKER
Excellent communication, really helped me out!
Your welcome anytime tks so much for the grade and let me know if you need assistance in other question by posting a link in this question
Rgds/gowflow
Rgds/gowflow
each time you activate the button Run List you want to send a new list to be added to the old list in sheet List ? or simply create a new sheet call it whatever and have it have the list that was choosen ?
gowflow