?
Solved

Excel VBA loop list

Posted on 2011-09-06
27
Medium Priority
?
197 Views
Last Modified: 2012-05-12
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
0
Comment
Question by:Euro5
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 11
  • 10
  • 6
27 Comments
 
LVL 31

Expert Comment

by:gowflow
ID: 36489497
question
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
0
 
LVL 31

Expert Comment

by:gowflow
ID: 36489522
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
0
 
LVL 18

Expert Comment

by:krishnakrkc
ID: 36489652
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.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
                            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).Resize(, UBound(ka, 2)).Value
            End If
            .Range("a" & .Rows.Count).End(xlUp).Offset(1).Resize(3, UBound(ka, 2)).Value = k
        End With
    End If
   
End Sub


Kris
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:Euro5
ID: 36495732
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!!
0
 

Author Comment

by:Euro5
ID: 36495809
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!
0
 
LVL 18

Expert Comment

by:krishnakrkc
ID: 36495897
Hi,

Like this ..?

Kris
0
 

Author Comment

by:Euro5
ID: 36496073
Hi Kris,  I don't see anything..?
0
 
LVL 18

Expert Comment

by:krishnakrkc
ID: 36496121

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.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
    End If
   
End Sub

Kris
0
 
LVL 31

Expert Comment

by:gowflow
ID: 36496840
Euro5 let me know if u need help
gowflow
0
 

Author Comment

by:Euro5
ID: 36496850
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
0
 
LVL 18

Expert Comment

by:krishnakrkc
ID: 36496952

OK. you have to run the macro 3 times. I'll modify the macro later this evening.

Kris
0
 

Author Comment

by:Euro5
ID: 36497007
ok, thanks goflow
0
 
LVL 31

Expert Comment

by:gowflow
ID: 36503627
If he doesn't fix it then i'll spend sometime on it. I will follow-it up
gowflow
0
 
LVL 18

Expert Comment

by:krishnakrkc
ID: 36504035
Hi,

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

Open in new window

0
 
LVL 31

Expert Comment

by:gowflow
ID: 36504526
Euro5 I am not sure the last code is giving you what you want but anyway I let you comment
gowflow
0
 

Author Comment

by:Euro5
ID: 36509841
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
0
 
LVL 31

Expert Comment

by:gowflow
ID: 36510799
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
0
 

Author Comment

by:Euro5
ID: 36512224
Will do, thanks!
0
 
LVL 18

Expert Comment

by:krishnakrkc
ID: 36512401
Hi,

Run the macro 'RunAll' not the 'kTest'.

Kris
0
 
LVL 31

Expert Comment

by:gowflow
ID: 36513525
Euro5 did you try my solution ?
gowflow
0
 

Author Comment

by:Euro5
ID: 36513609
Gowflow no access right now. Will try ASAP! Thanks so much.
0
 
LVL 31

Expert Comment

by:gowflow
ID: 36515500
No problem tke your time.
gowflow
0
 

Author Comment

by:Euro5
ID: 36522876
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?
0
 
LVL 31

Accepted Solution

by:
gowflow earned 2000 total points
ID: 36522929
Yes sorry my mistake. I had run it so it had the dates there and obviously as you requested it is full. Here it is pls use this file and remmeber when dates are there it will not take it in concideration anymore.
gowflow
Sample.xls
0
 

Author Comment

by:Euro5
ID: 36529180
gowflow - No, that was my fault, I should have seen that! Thanks so much, this is perfect!
0
 

Author Closing Comment

by:Euro5
ID: 36529190
Excellent communication, really helped me out!
0
 
LVL 31

Expert Comment

by:gowflow
ID: 36531094
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
0

Featured Post

On Demand Webinar: Networking for the Cloud Era

Did you know SD-WANs can improve network connectivity? Check out this webinar to learn how an SD-WAN simplified, one-click tool can help you migrate and manage data in the cloud.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…

752 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question