I have a problem with Excel VBA coding.
I want to make one coding may copy data from one sheet to a sheet with certain conditions. my data in the form binary.
data in sheet1 has nearly a thousand row. I just want to take 15 random row of data from sheet1 to sheet 2. The criteria which must be fulfilled is that each column only has the sum of the column is 3. if not met, other data will be takenwhy it cannot work? i want to loop until ClmTtl is not 3, how can i fix it? please help me. or can i do with other method?
Randomize 'Initialize Random number seed
Dim MyRows() As Integer ' Declare dynamic array.
Dim numRows, percRows, finalClm, nxtRow, nxtRnd, chkrnd, copyRow As Integer
'Application.Calculation = xlCalculationManual
'Application.ScreenUpdating = False
'Application.EnableEvents = False
'Determine Number of Rows in Sheet1 Column A
numRows = Sheets(1).Cells(Rows.count, "A").End(xlUp).Row
'Get 20% of that number
percRows = 15
Dim clm, ClmTtl As Integer
'Allocate elements in Array
ReDim MyRows(percRows)
'Create Random numbers and fill array
Do While ClmTtl <> 3
For nxtRow = 1 To percRows
getNew:
'Generate Random number
nxtRnd = Int((numRows) * Rnd + 1)
'Loop through array, checking for Duplicates
For chkrnd = 1 To nxtRow
'Get new number if Duplicate is found
If MyRows(chkrnd) = nxtRnd Then GoTo getNew
Next
'Add element if Random number is unique
MyRows(nxtRow) = nxtRnd
Next
For clm = 1 To 5
ClmTtl = 0
For copyRow = 1 To percRows
ClmTtl = ClmTtl + Sheets(1).Cells(MyRows(copyRow), clm).Value
Next
Next
Loop
For copyRow = 1 To percRows
Sheets(1).Rows(MyRows(copyRow)).Copy _
Destination:=Sheets(3).Cells(copyRow, 1)
Next
'Application.Calculation = xlCalculationAutomatic
'Application.ScreenUpdating = True
'Application.EnableEvents = True
End Sub
See Question&Answers more detail:os