Note~ Sample file already attached with the mail which I sent on 18th
march 2011 for the same Subject Line.
HI Team,
I have written a code for selecting random data from master data.
Please find the checkpoints below.
Data Format:
Master Data will have n number of records.
Each Row will have 4 columns.
Each row in master data will have an Cite Count (i.e. Column 3 value)
as a Numeric value.
Requirements:
Random rows has to be selected from Master Data as per the below
request.
If the Cite Count (i.e. Column 3 value) is greater than 32 and Less
than 500, Then we have to select 32 rows randomly.
If the Cite Count (i.e. Column 3 value) is greater than 500 and Less
than 3200, Then we have to select 125 rows randomly.
If the Cite Count (i.e. Column 3 value) is greater than 3200 and Less
than 10000, Then we have to select 200 rows randomly.
If the Cite Count (i.e. Column 3 value) is greater than 10000 and Less
than 35000, Then we have to select 315 rows randomly.
There should not be repeated rows. (Random Data should not contain
duplicate rows.
Help Required for:
I have written the below code for the above requirement
Sub RandData()
Dim CiteCnt, Rcnt As Long
Dim RandCiteCnt As Integer
Worksheets("Sample_Audit").Activate
Worksheets("Random_Data").Range("A2:IV65536").Clear
CiteCnt = WorksheetFunction.Sum(Range("C:C"))
RandCiteCnt = 0
If CiteCnt >= 32 And CiteCnt <= 500 Then
Do While RandCiteCnt < 32
Sheets("Sample_Audit").Select
rndrow = Int(Selection.CurrentRegion.Rows.Count * Rnd + 1)
If rndrow = 1 Then
Exit Do
End If
Rcnt = Rows(rndrow).Cells(3).Value
Rows(rndrow).EntireRow.Select
Selection.Copy
Sheets("Random_Data").Select
lastrow = Range("A65536").End(xlUp).Row + 1
Range("A" & lastrow).Select
Selection.PasteSpecial Paste:=xlPasteValues
ActiveSheet.Paste
RandCiteCnt = RandCiteCnt + Rcnt
Loop
ElseIf CiteCnt >= 501 And CiteCnt <= 3200 Then
Do While RandCiteCnt >= 125
Sheets("Sample_Audit").Select
rndrow = Int(Selection.CurrentRegion.Rows.Count * Rnd + 1)
Rcnt = Rows(rndrow).Cells(3).Value
Rows(rndrow).EntireRow.Select
Selection.Copy
Sheets("Random_Data").Select
lastrow = Range("A65536").End(xlUp).Row + 1
Range("A" & lastrow).Select
ActiveSheet.Paste
RandCiteCnt = RandCiteCnt + Rcnt
Loop
ElseIf CiteCnt >= 3201 And CiteCnt <= 10000 Then
Do While RandCiteCnt <= 200
Sheets("Sample_Audit").Select
rndrow = Int(Selection.CurrentRegion.Rows.Count * Rnd
+ 1)
Rcnt = Rows(rndrow).Cells(3).Value
Rows(rndrow).EntireRow.Select
Selection.Copy
Sheets("Random_Data").Select
lastrow = Range("A65536").End(xlUp).Row + 1
Range("A" & lastrow).Select
ActiveSheet.Paste
RandCiteCnt = RandCiteCnt + Rcnt
Loop
ElseIf CiteCnt >= 10001 And CiteCnt <= 35000 Then
Do While RandCiteCnt <= 315
Sheets("Sample_Audit").Select
rndrow = Int(Selection.CurrentRegion.Rows.Count * Rnd
+ 1)
Rcnt = Rows(rndrow).Cells(3).Value
Rows(rndrow).EntireRow.Select
Selection.Copy
Sheets("Random_Data").Select
lastrow = Range("A65536").End(xlUp).Row + 1
Range("A" & lastrow).Select
ActiveSheet.Paste
RandCiteCnt = RandCiteCnt + Rcnt
Loop
End If
End Sub
I could not get the exact output from the above coding as it results
the below:
The macro is terminated before the required random data requirement
exists.
Its selecting Duplicate rows.
It would be helpful if the above code had been evaluated and
redesigned to get the Required Output.
I have attached the sample documents for the above issue for your
reference.
WIth Thanks in advance,
R. K. M.
marimac...@gmail.com
--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Follow us on TWITTER for tips tricks and links :
http://twitter.com/exceldailytip
2. Join our LinkedIN group @ http://www.linkedin.com/groups?gid=1871310
3. Excel tutorials at http://www.excel-macros.blogspot.com
4. Learn VBA Macros at http://www.quickvba.blogspot.com
5. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
<><><><><><><><><><><><><><><><><><><><><><>
Like our page on facebook , Just follow below link
http://www.facebook.com/discussexcel
