Delete Row Loop Optimization VBA

Question

The code below was written as part of a random sample generator. Based on the total number of occurences, it calculates the sample size and reduces the population to the sample size. Right now I'm doing this by deleting the difference between the total and the sample size. I'd like to see if there's a better way of going about this. I'm getting a sample of each value in a user-defined column and working with a large data set, so the sampling ends up taking a few minutes.

Is there way to delete the number of rows I need to all at once instead of having to do them one at a time as seen in the loop below, or a better way to go about this altogether? Thank you!

x = (Population - SampleSize)

    If Population > SampleSize Then
        Do Until x = 0
            Workbooks(SourceBook).Sheets(SampleSheet).Columns(StratCol) _
            .Find(What:=SubPop, After:=Cells(SampRows, StratCol), LookIn:=xlValues, _
                SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False).EntireRow.Delete

        x = x - 1

        Loop

    End If

Answer 1

You can build a range that contains multiple non-contiguous rows and then delete all of them at once. This will probably speed things up a bit.

x = (Population - SampleSize)

dim MyRange as Range

If Population > SampleSize Then
    Do Until x = 0
        if MyRange Is Nothing Then
            Set MyRange = Workbooks(SourceBook).Sheets(SampleSheet).Columns(StratCol) _
                .Find(What:=SubPop, After:=Cells(SampRows, StratCol), LookIn:=xlValues, _
                SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False).EntireRow
        Else
            Set MyRange = Application.Union(MyRange, Workbooks(SourceBook).Sheets(SampleSheet).Columns(StratCol) _
                .Find(What:=SubPop, After:=Cells(SampRows, StratCol), LookIn:=xlValues, _
                SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False).EntireRow)
        End If
        x = x - 1
    Loop
    MyRange.Delete
End If