Sub Sup30Col()
Dim a() As Byte, c%, r&, b&, d&, f&, i&
c = ActiveCell.Column: r = Cells(Rows.Count, c).End(xlUp).Row: ReDim a(1 To r): f = Round(0.3 * r): Randomize
Do
d = Int(r * Rnd) + 1
If a(d) = 0 Then a(d) = 1: b = b + 1
Loop Until b = f
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
For i = r To 1 Step -1
If a(i) = 1 Then Cells(i, c).Delete Shift:=xlUp
Next i
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic: Cells(1, c).Select
End Sub