Transfer Ecel project to Access, random selection

B

Boblebad

New member
Local time
Today, 10:24
Joined
Oct 16, 2014
Messages
6
Hi

I work on a project where we have to randomly select 290 "numbers" out of 1080, the 1080 are separated into smaller groups, and there needs to be a specific amount of numbers from each group, it works perfect in Excel using macros, can it work in Access ?

Why this, cause this would eliminate a lot of error possibilities be course of the way it afterwards needs to be processed in Word, it needs to be cut up in to separate chunks cause of some limits in Word, how it handles import into fields.

And then there's the possibility of doing the word part here by generating a report, so it could be a one-click action :)

Well, the user needs to put in name, dates and number of days, but that's another story.

All the best
Carsten
 
It should be possible. It might help to see the working Excel code, and how the data is structured in Access.
 
Re: Transfer Excel project to Access, random selection

Thanks for your reply Paul

The database structure will be very simple:

Auto number
Affirmation
Group (this is where the 1080 "numbers" gets separated into groups)
Catagory

This is the macro from Excel:

Code: 
Sub AllInOneGruppe1_91dage273oevelser()

  Dim myUsedNumbers(1 To 1080) As Boolean
  Dim iCount, myRandom As Integer
  Randomize
  For iCount = 1 To 3
    Do
      myRandom = Int(108 * Rnd) + 325
    Loop While myUsedNumbers(myRandom)
    Range("A" & iCount).Value = myRandom
    myUsedNumbers(myRandom) = True
  Next iCount

  Dim myUsedNumbers2(1 To 1080) As Boolean
  Dim iCount2, myRandom2 As Integer
  Randomize
  For iCount2 = 1 To 3
    Do
      myRandom2 = Int(108 * Rnd) + 109
    Loop While myUsedNumbers2(myRandom2)
    Range("A" & iCount2 + 3).Value = myRandom2
    myUsedNumbers2(myRandom2) = True
  Next iCount2
  
    Dim myUsedNumbers3(1 To 1080) As Boolean
  Dim iCount3, myRandom3 As Integer
  Randomize
  For iCount3 = 1 To 2
    Do
      myRandom3 = Int(108 * Rnd) + 541
    Loop While myUsedNumbers3(myRandom3)
    Range("A" & iCount3 + 6).Value = myRandom3
    myUsedNumbers3(myRandom3) = True
  Next iCount3
  
      Dim myUsedNumbers4(1 To 1080) As Boolean
  Dim iCount4, myRandom4 As Integer
  Randomize
  For iCount4 = 1 To 2
    Do
      myRandom4 = Int(108 * Rnd) + 757
    Loop While myUsedNumbers4(myRandom4)
    Range("A" & iCount4 + 8).Value = myRandom4
    myUsedNumbers4(myRandom4) = True
  Next iCount4
  
        Dim myUsedNumbers5(1 To 1026) As Boolean
  Dim iCount5, myRandom5 As Integer
  Randomize
  For iCount5 = 1 To 4
    Do
      myRandom5 = Int(54 * Rnd) + 973
    Loop While myUsedNumbers5(myRandom5)
    Range("A" & iCount5 + 10).Value = myRandom5
    myUsedNumbers5(myRandom5) = True
  Next iCount5
  
          Dim myUsedNumbers6(1 To 1080) As Boolean
  Dim iCount6, myRandom6 As Integer
  Randomize
  For iCount6 = 1 To 50
    Do
      myRandom6 = Int(108 * Rnd) + 1
    Loop While myUsedNumbers6(myRandom6)
    Range("A" & iCount6 + 14).Value = myRandom6
    myUsedNumbers6(myRandom6) = True
  Next iCount6
  
            Dim myUsedNumbers7(1 To 1080) As Boolean
  Dim iCount7, myRandom7 As Integer
  Randomize
  For iCount7 = 1 To 50
    Do
      myRandom7 = Int(108 * Rnd) + 217
    Loop While myUsedNumbers7(myRandom7)
    Range("A" & iCount7 + 64).Value = myRandom7
    myUsedNumbers7(myRandom7) = True
  Next iCount7
  
              Dim myUsedNumbers8(1 To 1080) As Boolean
  Dim iCount8, myRandom8 As Integer
  Randomize
  For iCount8 = 1 To 50
    Do
      myRandom8 = Int(108 * Rnd) + 433
    Loop While myUsedNumbers8(myRandom8)
    Range("A" & iCount8 + 114).Value = myRandom8
    myUsedNumbers8(myRandom8) = True
  Next iCount8
  
                Dim myUsedNumbers9(1 To 1080) As Boolean
  Dim iCount9, myRandom9 As Integer
  Randomize
  For iCount9 = 1 To 50
    Do
      myRandom9 = Int(108 * Rnd) + 649
    Loop While myUsedNumbers9(myRandom9)
    Range("A" & iCount9 + 164).Value = myRandom9
    myUsedNumbers9(myRandom9) = True
  Next iCount9
  
                  Dim myUsedNumbers10(1 To 1080) As Boolean
  Dim iCount10, myRandom10 As Integer
  Randomize
  For iCount10 = 1 To 59
    Do
      myRandom10 = Int(108 * Rnd) + 865
    Loop While myUsedNumbers10(myRandom10)
    Range("A" & iCount10 + 214).Value = myRandom10
    myUsedNumbers10(myRandom10) = True
  Next iCount10
    
  For iCountF = 1 To 3

  Dim myUsedNumbersRC(1 To 1080) As Boolean
  Dim iCountRC, myRandomRC As Integer
  Randomize
  For iCountRC = 1 To 273
    Do
      myRandomRC = Int(1080 * Rnd) + 1
    Loop While myUsedNumbersRC(myRandomRC)
    Range("B" & iCountRC).Value = myRandomRC
    myUsedNumbersRC(myRandomRC) = True
  Next iCountRC

x = Range("B" & Rows.Count).End(xlUp).Row
Range("A1:B" & x).Sort Key1:=Range("B1"), Order1:=xlAscending

Next iCountF

For iCountF2 = 1 To 3

  Dim myUsedNumbersRC2(1 To 1080) As Boolean
  Dim iCountRC2, myRandomRC2 As Integer
  Randomize
  For iCountRC2 = 1 To 273
    Do
      myRandomRC2 = Int(1080 * Rnd) + 1
    Loop While myUsedNumbersRC2(myRandomRC2)
    Range("B" & iCountRC2).Value = myRandomRC2
    myUsedNumbersRC2(myRandomRC2) = True
  Next iCountRC2

x = Range("B" & Rows.Count).End(xlUp).Row
Range("A1:B" & x).Sort Key1:=Range("B1"), Order1:=xlAscending

Next iCountF2

For iCountF3 = 1 To 3

  Dim myUsedNumbersRC3(1 To 1080) As Boolean
  Dim iCountRC3, myRandomRC3 As Integer
  Randomize
  For iCountRC3 = 1 To 273
    Do
      myRandomRC3 = Int(1080 * Rnd) + 1
    Loop While myUsedNumbersRC3(myRandomRC3)
    Range("B" & iCountRC3).Value = myRandomRC3
    myUsedNumbersRC3(myRandomRC3) = True
  Next iCountRC3

x = Range("B" & Rows.Count).End(xlUp).Row
Range("A1:B" & x).Sort Key1:=Range("B1"), Order1:=xlAscending

Next iCountF3

For iCountF4 = 1 To 3

  Dim myUsedNumbersRC4(1 To 1080) As Boolean
  Dim iCountRC4, myRandomRC4 As Integer
  Randomize
  For iCountRC4 = 1 To 273
    Do
      myRandomRC4 = Int(1080 * Rnd) + 1
    Loop While myUsedNumbersRC4(myRandomRC4)
    Range("B" & iCountRC4).Value = myRandomRC4
    myUsedNumbersRC4(myRandomRC4) = True
  Next iCountRC4

x = Range("B" & Rows.Count).End(xlUp).Row
Range("A1:B" & x).Sort Key1:=Range("B1"), Order1:=xlAscending

Next iCountF4

For iCountF5 = 1 To 3

  Dim myUsedNumbersRC5(1 To 1080) As Boolean
  Dim iCountRC5, myRandomRC5 As Integer
  Randomize
  For iCountRC5 = 1 To 273
    Do
      myRandomRC5 = Int(1080 * Rnd) + 1
    Loop While myUsedNumbersRC5(myRandomRC5)
    Range("B" & iCountRC5).Value = myRandomRC5
    myUsedNumbersRC5(myRandomRC5) = True
  Next iCountRC5

x = Range("B" & Rows.Count).End(xlUp).Row
Range("A1:B" & x).Sort Key1:=Range("B1"), Order1:=xlAscending

Next iCountF5

For iCountF6 = 1 To 3

  Dim myUsedNumbersRC6(1 To 1080) As Boolean
  Dim iCountRC6, myRandomRC6 As Integer
  Randomize
  For iCountRC6 = 1 To 273
    Do
      myRandomRC6 = Int(1080 * Rnd) + 1
    Loop While myUsedNumbersRC6(myRandomRC6)
    Range("B" & iCountRC6).Value = myRandomRC6
    myUsedNumbersRC6(myRandomRC6) = True
  Next iCountRC6

x = Range("B" & Rows.Count).End(xlUp).Row
Range("A1:B" & x).Sort Key1:=Range("B1"), Order1:=xlAscending

Next iCountF6

For iCountF7 = 1 To 3

  Dim myUsedNumbersRC7(1 To 1080) As Boolean
  Dim iCountRC7, myRandomRC7 As Integer
  Randomize
  For iCountRC7 = 1 To 273
    Do
      myRandomRC7 = Int(1080 * Rnd) + 1
    Loop While myUsedNumbersRC7(myRandomRC7)
    Range("B" & iCountRC7).Value = myRandomRC7
    myUsedNumbersRC7(myRandomRC7) = True
  Next iCountRC7

x = Range("B" & Rows.Count).End(xlUp).Row
Range("A1:B" & x).Sort Key1:=Range("B1"), Order1:=xlAscending

Next iCountF7

    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
    
End Sub
This will give me 273 "numbers" from 4 groups where there needs to be a specific amount from each.

The "numbers" can be reorganized, so that the initial groups will be only 6, i that way the code can be shortened too.

And as written, the output needs to be usable for a report.

All the best
Carsten
 
Sorry Carsten, my adult-onset ADD kicked in when I saw all that code. :p

Can you perhaps post a db here with sample data in it? I'll try and play with some code to pull randomly select records.
 
Sorry for my late reply, hadn't seen yours.

Here a test database: Dropbox, and after url copy/paste: /sh/ozdinty64g2plex/AAD8ua32jcmWBjOmG4x1VwRta?dl=0 - can't post links.

As you can see, the data is separated into groups, and i need to be able to select a specific number of lines from each group.

Thanks for your help :)
 
The problem is that i haven't had 10 posts yet, therefor i can't add links to my posts. So for the time being, you will have to write www and dropbox dot com on you own, and then copy paste the rest from my post, then you will get to the file :)
 
You are not asked to add links, but to attach the db (zip it) as per the link Paul gave you.
 
Does this do what you want?
 

Attachments

You must log in or register to reply here.

Similar threads

S
Free lancing on weekends for Excel VBA projects? Possible? Reality? Legal?
2
Replies
22
Views
917
SachAccess
S
W
Combined Queries
Replies
15
Views
1,413
Ken Sheridan
Ken Sheridan
R
Conditional Formatting works only randomly
Replies
8
Views
753
Reno911
R
M
Add row number to randomly selected records
Replies
16
Views
1,900
LarryE
LarryE
E
Solved correct query syntax - (re making the found word appear red colored in report)
Replies
9
Views
755
EdK
E

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom