Code to randomize within a filter

I was presented a scenario from my boss and was wondering if somebody could help me out. My sample spreadsheet attached has only 1,500 records but the actual one has about 10,000 records and was wondering if there was a code to help me reduce my sample.

I was asked to find a way to find a way where I could randomly select 2 records for each client. The catch is that the 2 records have to be different states.

To further complicate things, I have to do this once a month and for each month, I need records on states that have yet to be selected until all 50 states are selected, and then the process starts over again.

I was wondering if there was a code that could me with at least some of this process but any ideas, suggestions, comments, anything would be greatly appreciated. I don't know where to start.

Thanks!
Scott

Hi Scott,
maybe something like this

Sub ertert()
Dim x, i&, j&, s$
x = Range("A1:B" & Cells(Rows.Count, 1).End(xlUp).Row).Value
With CreateObject("Scripting.Dictionary")
    .CompareMode = 1
    For i = 1 To UBound(x)
    s = x(i, 1) & "~" & x(i, 2)
        If .exists(x(i, 1)) Then
            If Not .exists(s) Then
                .Item(x(i, 1)) = .Item(x(i, 1)) + 1
                If .Item(x(i, 1)) < 3 Then j = j + 1: x(j, 1) = x(i, 1): x(j, 2) = x(i, 2)
            End If
        Else
            j = j + 1: x(j, 1) = x(i, 1): x(j, 2) = x(i, 2)
            .Item(x(i, 1)) = 1: .Item(s) = Empty
        End If
    Next i
End With
[E:F].ClearContents: [E1:F1].Resize(j).Value = x
End Sub

Now does that run automatically or would I have to run a macro/create a button?

Also the spreadsheet I'm working with has the same objective, but column A in my sample spreadsheet is column J and my column B in the sample is column F in my company spreadsheet. How much does that change the code?

here is your file with a button

Oh awesome! Thank you. I have another question for you. Is there a way to clear the contents and then click the same button to yield more results. So after the first month I would could repeat the process.

Also, is that randomized because after I clicked the button almost every 2 records for each client was AK and CA. Either that's a crazy coincidence but it seems almost alphabetical.

then let's try this

Sub ertert()
Dim x, y, i&, j&, s$
Application.ScreenUpdating = False
y = Range("L1:M" & Cells(Rows.Count, 12).End(xlUp).Row).Value

With Range("F2:K" & Cells(Rows.Count, 6).End(xlUp).Row)
    .Columns(6).FormulaR1C1 = "=RANDBETWEEN(1," & .Rows.Count & ")"
    .Sort Key1:=.Cells(1, 6), Order1:=xlAscending
    x = .Value
    .Columns(6).ClearContents
    .Sort Key1:=.Cells(1, 5), Order1:=xlAscending, Key2:=.Cells(1, 1), Order2:=xlAscending
End With

With CreateObject("Scripting.Dictionary")
    .CompareMode = 1
    For i = 1 To UBound(y)
        .Item(y(i, 2) & "~" & y(i, 1)) = Empty
    Next i

    For i = 1 To UBound(x)
        s = x(i, 1) & "~" & x(i, 5)
        If Not .exists(s) Then
            .Item(s) = Empty
            If .exists(x(i, 5)) Then
                .Item(x(i, 5)) = .Item(x(i, 5)) + 1
                If .Item(x(i, 5)) < 3 Then j = j + 1: x(j, 2) = x(i, 1): x(j, 1) = x(i, 5)
            Else
                j = j + 1: x(j, 2) = x(i, 1): x(j, 1) = x(i, 5)
                .Item(x(i, 5)) = 1
            End If
        End If
    Next i
End With

If j > 0 Then
    [L:M].ClearContents: [L1:M1].Resize(UBound(y)).Value = y
    With Cells(Rows.Count, 12).End(xlUp)(2).Resize(j, 2)
        .Value = x
        .Sort Key1:=.Cells(1, 1), Order1:=xlAscending
    End With
Else
    MsgBox "That's all, no more records", 64
End If
Application.ScreenUpdating = True
End Sub

Oh awesome!! I just have a few more question about making some modifications. If I were to put the data onto another sheet? Would that change the code at all? Also, although I'm only using columns F and J, is it possible to transfer the entire row over to the new sheet?

Thank you!!

Scott,
without your example, I can only say that this is possible

Okay I'll make a sample spreadsheet for you and post it when I get back into work tomorrow. Thanks for all of your help today!

Hello,

so I attached a spreadsheet that isn't exactly the same as my actual one, but it's the same design. I was wondering if there was a way to put the data selected onto a new sheet, or at the very least have the data selected with the code already used, but move the entire row over to the gray box. I was really hoping to do this without using an Index/Match equation.

Thanks.

Actually, it would be better if I could just duplicate the record in a different area after pressing the button