Creating random subset of list then retreiving other columns

[tutu1201]

Can't think of any other way to describe this.

I Have Excel 2010 and a voter registration list in 1 sheet. A blank sheet will contain a random selection from the VR sheet. Since it only pulls the name, I am trying to write VB code to:
1. Loop through the random sheet, picking the next name and storing to a variable.
2. Activate the VR sheet and read down the list to find a match of name.
3. Once located, copy the entire row data.
4. Return to the random sheet and paste the contents of the var into the row from which just the name was originally retrieved.
5. Move to the next row in the random sheet and repeat until all have been taken care of.

You know, if I just had my trusty, good old dBase III+ or even IV, I'd have this knocked out in no time. Visual Basic -- not my forte.

Can anyone help me code this?

Thanks.

 

[AnAnalyst]

Hi there,

A couple of questions:

How is the random selection generated initially?

Are the names all unique?

How many records are you dealing with?

 

[tutu1201]

There are 2700 total Voter Records. First, I created new sheets for "REPs," "DEMs," "NPs," "All Else." I populated those with the appropriate records. Next, I used "=INDEX(A$2:A$677,INT((RAND()*678)+1),1)" to get a random list of REPs, then copied those names to a new sheet (pasted as value only).

Now I have my Randoms sheet with a list of names only and I need the rest of the person's information from the "REPs" sheet. That's where my VB problem arises. I don't want to have to go through the previous list and manually copy over the rest of the record. It occurred to me that I could create some sort of macro to do that all for me.

Does that help for an answer? Let me know if you need more.

 

[AnAnalyst]

Okay,

I would probably have approached this differently.

I'd get the vba to generate the random numbers on your source sheet in an empty column, sort the list by the random number field and then just copy the required number of records in their entirety from the top of the sorted dataset.

 

[AnAnalyst]

... as an example of what I mean, paste the following code into a standard vba module:

Sub RandomSample()
    ' Variable definitions
    Dim intLastColumn As Integer
    Dim dblLastRow As Double
    Dim shtSourceSheet As Worksheet
    Dim shtRandoms As Worksheet
    Dim lngSampleSize As Long
    Dim objCell As Object
    Set shtSourceSheet = ActiveSheet
    ' Find the last column, last row
    With shtSourceSheet
        intLastColumn = .Cells(1, Columns.Count).End(xlToLeft).Column
        dblLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        .Cells(1, intLastColumn + 1).Value = "Rand"
    End With
    ' Setting the sample size to roughly ten percent
    lngSampleSize = WorksheetFunction.RoundUp(dblLastRow * 10 / 100, 0)
    ' Fill the Rand column with random numbers
    With shtSourceSheet.Cells(2, intLastColumn + 1).Resize(dblLastRow - 1, 1)
        .Formula = "=RAND()"
        .Copy
        .PasteSpecial xlValues
    End With
    Application.CutCopyMode = False
    ' Sort the sheet by the random numbers
    With shtSourceSheet.Sort
        With .SortFields
            .Clear
            .Add _
                Key:=shtSourceSheet.Cells(1, intLastColumn + 1).Resize(dblLastRow, 1), _
                SortOn:=xlSortOnValues, _
                Order:=xlAscending, _
                DataOption:=xlSortNormal
        End With
        .SetRange shtSourceSheet.Cells(1, 1).Resize(dblLastRow, intLastColumn + 1)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    [A1].Activate
    ' Remove the redundant Rand column
    With shtSourceSheet
        .Cells(1, intLastColumn + 1).EntireColumn.Delete
        ' Copy the sample
        .Cells(1, 1).Resize(lngSampleSize, intLastColumn).Copy
    End With
    ' Add a sheet as a sample repository
    ThisWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
    Set shtRandoms = ActiveSheet
    ' Paste the sample
    With shtRandoms
        .PasteSpecial
        ' Name and date/time stamp the sample sheet
        .Name = shtSourceSheet.Name & " Sample " & Format(Now(), "yyyymmdd hhmmss")
    End With
    Application.CutCopyMode = False
    ' Clean up
    Set shtSourceSheet = Nothing
    Set shtRandoms = Nothing
End Sub

This code works on the active source sheet, and randomly samples 10%(ish) of the source list to a new date/time stamped sheet.

 

[tutu1201]

Thanks for the code. I seem to be having problems with the following area:

With shtSourceSheet.Cells(2, intLastColumn + 1).Resize(dblLastRow - 1, 1)
.Formula = "=RAND()"
.Copy
.PasteSpecial xlValues
End With

It crashes on the .PasteSpecial xlValues line.

Any ideas?

 

[AnAnalyst]

Hmm ... worked as is in my copy of 2010.

Try replacing

.PasteSpecial xlValues

with

.PasteSpecial Paste:=xlPasteValues

Let me know if this resolves the issue for you.

There are actually a few places I would expect this code to bug out - and that wasn't actually one of them!

I didn't include checks for:

• No (or not enough) source data
• Worksheet/book protection
• Length of name to be applied to the newly created sample sheet

 

[tutu1201]

I had already tried that one with no luck. Have been wracking my brain on this one. The spreadsheet column RAND displays random numbers to the bottom of the data (i.e., 2700). That would indicate to me (but, what do I know I'm a lawyer) that the process has generated all of the numbers and craps out when it thinks that it's supposed to do another.

Thanks for your quick reply.

 

[AnAnalyst]

Very strange

Okay, try replacing the code with the following, which removes the copy/paste operation where it seems to be causing a problem and adds a simple error handler.

Sub RandomSample()
    ' Variable definitions
    Dim intLastColumn As Integer
    Dim dblLastRow As Double
    Dim shtSourceSheet As Worksheet
    Dim shtRandoms As Worksheet
    Dim lngSampleSize As Long
    Dim objCell As Object
    Set shtSourceSheet = ActiveSheet
    On Error GoTo cleanup
    ' Find the last column, last row
    With shtSourceSheet
        intLastColumn = .Cells(1, Columns.Count).End(xlToLeft).Column
        dblLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        .Cells(1, intLastColumn + 1).Value = "Rand"
    End With
    ' Setting the sample size to roughly ten percent
    lngSampleSize = WorksheetFunction.RoundUp(dblLastRow * 10 / 100, 0)
    ' Fill the Rand column with random numbers
    Application.Calculation = xlCalculationManual
    With shtSourceSheet.Cells(2, intLastColumn + 1).Resize(dblLastRow - 1, 1)
        .Formula = "=RAND()"
    End With
    Application.CutCopyMode = False
    ' Sort the sheet by the random numbers
    With shtSourceSheet.Sort
        With .SortFields
            .Clear
            .Add _
                Key:=shtSourceSheet.Cells(1, intLastColumn + 1).Resize(dblLastRow, 1), _
                SortOn:=xlSortOnValues, _
                Order:=xlAscending, _
                DataOption:=xlSortNormal
        End With
        .SetRange shtSourceSheet.Cells(1, 1).Resize(dblLastRow, intLastColumn + 1)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ' Remove the redundant Rand column
    With shtSourceSheet
        .Cells(1, intLastColumn + 1).EntireColumn.Delete
        ' Copy the sample
        .Cells(1, 1).Resize(lngSampleSize, intLastColumn).Copy
    End With
    ' Add a sheet as a sample repository
    ThisWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
    Set shtRandoms = ActiveSheet
    ' Paste the sample
    With shtRandoms
        .PasteSpecial
        ' Name and date/time stamp the sample sheet
        .Name = shtSourceSheet.Name & " Sample " & Format(Now(), "yyyymmdd hhmmss")
    End With
    Application.CutCopyMode = False
    ' Clean up
cleanup:
    Application.Calculation = xlCalculationAutomatic
    Set shtSourceSheet = Nothing
    Set shtRandoms = Nothing
    If Err <> 0 Then
        MsgBox _
            Err.Source & vbLf & _
            "Error number : " & Err.Number & vbLf & _
            Err.Description, vbCritical, "Error"
    End If
End Sub

 

[tutu1201]

Tried the new one. Seems to work fine UNTIL:
With shtRandoms
.PasteSpecial
' Name and date/time stamp the sample sheet
.Name = shtSourceSheet.Name & " Sample " & Format(Now(), "yyyymmdd hhmmss")
End With

then crashes with an error 1004 referencing the renaming of the sheet tab, I presume. But, you know what? I can live with that. I can even fix that!

Thank you so much for your help.