Hi Friends,
Is there any updates on my below query...
On Fri, Mar 18, 2011 at 1:42 AM, Mariappan Kulasekaran <marimac...@gmail.com
> wrote:
> 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
>
--
----------------------------------------------------------------------------------
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
