Macro to copy data based on criteria - Percentage - For sampling

[shan]

Hello Everyone,

I request your help on Macro to copy data from one sheet to another sheet based on percentage criteria. The purpose of this is Sampling.

Description:

I have a file which has 3 columns Col1-Sr No., Col2-TYPE, Col3-Data.
In the file there are 3 Types - C,R and T ( featuring under TYPE column). I want do extrat a samples for these TYPEs.

I want,

8% samples for C - if in decimal round-off on higher side
10% samples for R - if in decimal round-off on higher side
15% samples for T - if in decimal round-off on higher side

... Also I have attached a Excel for better understanding

Hope I am able to explain you properly...

Thanks
Regards
Shan

[excelliot]

do you want to add data in existing data in sheets C, R, T or replace?

do you want to have duplicate records there or only unique one?

how you want to trigger action? thru input box or any other method?

Cheers!!
www.excelliot.com

[shan]

Thank you for your reply

Answer to your queries

do you want to add data in existing data in sheets C, R, T or replace?
Ans- In sheets C,R,T ... each time we will be using a new file ... hence sheet C,R,T will not have any data

do you want to have duplicate records there or only unique one?
Ans- only unique records

how you want to trigger action? thru input box or any other method?
Ans- Sorry but I did not get this

[excelliot]

Shan,

Check this attachment.. Click on blue button to run macro..

1st you will be prompted for entering type, you need to enter either of C, R , T..

After that you will be prompted for entering %, just enter number & press ok..

A new sheet will be generated by Input Given.. You can repeat this steps to get output for other Type.

Cheers!!
www.excelliot.com

[shan]

Thank you so much Sir.

This is working fine. But I need to hardcode this into the code... I do not want user to put any % or Type Value...
Also one thing sir.. code is considering Header as a one row... which should not be the case.

[excelliot]

Ok, check this..

[shan]

Thank you so much Sir.
It is working fine ... only one thing

Now I have change % to C=90, R=55 and T=80 ... but one row is capture less for C and R.

The total row count for C is 7 so =7*.90=6.3 .... we need to round-off to higher side i.e. 7 .... hence 7 rows should have copied for C instead of 6 rows.

The total row count for R is 7 so =8*.55=4.4 .... we need to round-off to higher side i.e. 5 .... hence 5 rows should have copied for C instead of 4 rows.

The rows for T is captured correctly as the full number came after calculation i.e. =5*.80=4 .... hence 4 rows correctly ccopied

[shan]

Hello Sir,

I am sorry ... forgot to incorporate one more criteria ...

If values under DATA column are repeated for same TYPE then code should pick up only one value..

e.g.

for TYPE C ... we need to extract 3 rows out of 7 rows ... if for first two rows value under DATA is same then code should the this only one row out of these two rows and remaining 2 rows which are unique based on DATA.

tx

[excelliot]

this covers all your requirements:

You can mark thread as completed & also add Reputation if it is helpful..


Cheers!!
www.excelliot.com

[shan]

Thank you Sir..

How do I use Roundup function in below code created by you...

wks.Activate
lr = Cells(Rows.Count, 1).End(xlUp).Row
lr2 = Application.WorksheetFunction.Max(1, Round((lr - 1) * fPc / 100, 0)) + 2
Range("A" & lr2 & ":A" & lr).EntireRow.Delete

[shan]

Once this is done I will mark the thread as Complete

[excelliot]

change this line buddy

lr2 = Application.WorksheetFunction.Max(1, Round((lr - 1) * fPc / 100, 0)) + 2

to

lr2 = RoundUp((lr - 1) * fPc / 100, 1) + 2

Cheers!!
excelliot.com

[shan]

Sir,

I tried this is giving me error as Compile Error... Sub or Function not defined

[shan]

I have run below code its working only for "R" but not running for "C" and "T"

lr2 = Application.WorksheetFunction.RoundUp((lr - 1) * fPc / 100, 0) + 2

[excelliot]

my bad..try this

lr2 = Application.WorksheetFunction.RoundUp((lr - 1) * fPc / 100, 1) + 2

Cheers!!

[shan]

Sorry Sir,
But code is not rounding up the number. Hence I have changed the code as below but the same is excepting only for "R" and not for "C" and "T".

lr2 = Application.WorksheetFunction.RoundUp((lr - 1) * fPc / 100, 0) + 2

[shan]

Sorry Sir... Its working fine with the above code...
Thank you so much for your help
I am marking this thread as Completed

[excelliot]

Great!!

[shan]

Sorry to bother you again Sir!!!

Whichever row we are coping and pasting on "C", "R" and "T" sheets... can it will be randomly picked up based on percentage
Currently First row is getting picked up by this code..

[excelliot]

yes..any thing else you need to customise?