Private Sub CommandButton4_Click()
Dim rng As Range
Dim RngAddr As String, t As Single
Dim arr
t = Timer
Columns( 2 ).ClearContents
With Application
  .ScreenUpdating = False
  Set rng = Range(Cells( 2 ,  1 ), Cells(Rows.Count,  1 ).End(xlUp))
  RngAddr = rng.Address
  arr = Split(.Trim(Join(Evaluate("TRANSPOSE(IF(FREQUENCY(" & RngAddr & "," & RngAddr & ")," & RngAddr & ",""""))"), " ")), " ")
  rng.Offset(,  1 ).Resize(UBound(arr) +  1 ) = .Transpose(arr)
End With
[CalcTime] = Timer - t
End Sub

Range("$A$1:$A$6,$A$195:$A$199,$A$388:$A$392,$A$581:$A$585,$A$774:$A$778,$A$967:$A$971").Copy [EmptyCell]

Private Sub CommandButton8_Click()
  Dim arr, arr1, x, i&, j&, c As New Collection, t As Single
  t = Timer
  On Error Resume Next
  Application.ScreenUpdating = False
  With Range(Cells( 2 ,  1 ), Cells(Rows.Count,  1 ).End(xlUp))
    arr = .Value
    j = UBound(arr)
    ReDim arr1(j,  1  To  1 )
    For Each x In arr
      Err.Clear
      c.Add  0 , CStr(x)
      If Err =  0  Then
        arr1(i,  1 ) = x
        i = i +  1 
      End If
    Next
    .Offset(,  1 ).Value = arr1
  End With
  Range("CalcTime") = Timer - t
End Sub