Help Required : Random Sampling of Data

[Paul_Hossler]

This seems faster in my tests

Option Explicit


Sub ViewStastistics()
    Dim wsTemp As Worksheet
    Dim ptTemp As PivotTable
    Dim sStrata As String
    Dim aryFromData As Variant
    Dim i As Long
    
    Application.ScreenUpdating = False
    
    'fill in blanks if any
    On Error Resume Next
    rData.Columns(colStrataPicked).SpecialCells(xlCellTypeBlanks).Value = "(blank)"
    On Error GoTo 0
    
    sStrata = aryStrataHeaders(colStrataPicked)
    
    'new temp sheet
    Set wsTemp = Worksheets.Add
    
    'create pivot table
    ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rData, Version:=7).CreatePivotTable _
        TableDestination:=wsTemp.Cells(1, 1), TableName:="PivotTable2", DefaultVersion:=7


    Set ptTemp = wsTemp.PivotTables(1)
    
    'Count of goes first
    With ptTemp
        .AddDataField .PivotFields(sStrata), "Count of " & sStrata, xlCount
        With .PivotFields(sStrata)
            .Orientation = xlRowField
            .Position = 1
        End With
    
        .RowAxisLayout xlTabularRow
        .ColumnGrand = True
        .RowGrand = False
    
        .PivotFields(sStrata).AutoSort xlDescending, "Count of " & sStrata
    
        aryFromData = .TableRange2.Value
    End With
    
    'delete PT worksheet
    Application.DisplayAlerts = False
    wsTemp.Delete
    Application.DisplayAlerts = True
    
    ReDim Preserve aryFromData(LBound(aryFromData, 1) To UBound(aryFromData, 1), LBound(aryFromData, 2) To UBound(aryFromData, 2) + 1)
    
    'put in column heders
    aryFromData(LBound(aryFromData, 1), 1) = "Strata Values"
    aryFromData(LBound(aryFromData), 2) = "Count"
    aryFromData(LBound(aryFromData), 3) = "Percentage"


    'put in totals
    aryFromData(UBound(aryFromData, 1), 1) = "Total"
    aryFromData(UBound(aryFromData, 1), 2) = numRowsOfData
    aryFromData(UBound(aryFromData, 1), 3) = "100%"
    
    'put in percentage
    For i = LBound(aryFromData, 1) + 1 To UBound(aryFromData, 1) - 1
        aryFromData(i, 3) = Format(aryFromData(i, 2) / numRowsOfData, "0.00%")
    Next i
    
    Load UF_StrataList
    
    With UF_StrataList.lbSummary
        .ColumnCount = UBound(aryFromData, 2) + 1
        .ColumnWidths = "250;50;50"
        .List = aryFromData
    End With


    Erase aryFromData


    Application.ScreenUpdating = True
End Sub