Save results from a query to an array

Good afternoon!

I need to get the results of this query:

sql = "SELECT controle.ID FROM controle WHERE BP = '" & controlectform.nmbpbox.Value & "';"

And save to an array. Subsequently I will do a for each in that array and I will use the results stored in a new query.

For each I have done but the data is not inserted into my array, so the query only runs the first time.

The full code below follows.

Function InsereDados()

    Dim vArray As Variant
    Dim vContador As Integer
    Dim cn  As ADODB.Connection
    Dim rs  As ADODB.Recordset
    Dim arrid() As String
    Dim toid As Variant


    Set cn = New ADODB.Connection

    cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & enderecoDB & ";Jet OLEDB:Database"

    cn.Open

    Set rs = New ADODB.Recordset

    sql = "SELECT controle.ID FROM controle WHERE BP = '" & controlectform.nmbpbox.Value & "';"

    rs.Open sql, cn

    For i = 1 To rs.RecordCount

    arrid(0) = rs(0)

    Next

    For Each ID In arrid

    Call SelectIDENT
    Call SelectBENEFIT
    Call SelectBP
    Call SelectCPF
    Call SelectNome
    Call SelectADM
    Call SelectFilial
    Call SelectSOLICITANTE
    Call SelectDTSOLIC
    Call SelectRECEBIMENTO
    Call SelectENVIO
    Call SelectRETIROU
    Call SelectMINUTA
    Call SelectCARTAO

    vArray = Array("", SelectIDENT, SelectBENEFIT, SelectBP, SelectCPF, SelectNome, SelectADM, SelectFilial, SelectSOLICITANTE, _
        SelectDTSOLIC, SelectRECEBIMENTO, SelectENVIO, SelectRETIROU, SelectMINUTA, SelectCARTAO)

    count = 2

        With Worksheets("Planilha1")
           For vContador = 1 To UBound(vArray)
           .Cells(count, vContador).Value = vArray(vContador)
            Next vContador
        End With
    count = count + 1

   Next

End Function