do while loop in excel vba error

Question

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

Answer 1

While Den Temple is correct, and you really should Dim variables independently, the real problem here is with the logic of:

For clm = 1 To 5
  ClmTtl = 0

   For copyRow = 1 To percRows
       ClmTtl = ClmTtl + Sheets(1).Cells(MyRows(copyRow), clm).Value
   Next

Next

This clears ClmTtl each time, without doing anything with the total you've just calculated. Thus you're only checking the final column that you have picked. You'll need to add in a check within the loop which gets triggered if any of the totals is not 3, and have the While loop based on that.

You are also not clearing MyRows each time you go through the do loop, so if it fails the first time, it will fail every time.

Your loop might be better as something like:

    Dim claimTotalCheck As Boolean
    claimTotalCheck = True
    Do While claimTotalCheck
        ReDim MyRows(percRows)
        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

        claimTotalCheck = False
        For clm = 1 To 5
           ClmTtl = 0

            For copyRow = 1 To percRows
                ClmTtl = ClmTtl + Sheets(1).Cells(MyRows(copyRow), clm).Value
            Next

            If ClmTtl <> 3 Then
                claimTotalCheck = True
            End If
        Next
    Loop