Sub CSB()
    ' Shortcut: Ctrl+Shift+B, as in
    '   "conveniently show binary"
    frmShowBinary.ShowBinary
End Sub

'   Routine         Input                   Output           WF/VBA
'   -------- -------------------- -------------------------- ------
'   Byte2Sng ab(0 To 3)           Single                     VBA
'   Sng2Byte Single               4-byte array Variant       Both
'   Sng2Hex  Single               Hex String                 Both
'   Hex2Sng  Hex string           Single                     Both
'   Var2Sng  4-byte array Variant Single                     Both

'   Routine         Input                   Output           WF/VBA
'   -------- -------------------- -------------------------- ------
'   Byte2Dbl ab(0 To 7)           Double                     VBA
'   Dbl2Byte Double               8-byte array Variant       Both
'   Dbl2Hex  Double               Hex string                 Both
'   Hex2Dbl  Hex string           Double                     Both
'   Var2Dbl  8-byte array Variant Double                     Both

'   Routine         Input                   Output           WF/VBA
'   -------- -------------------- -------------------------- ------
'   Flt2Byte Single or Double     4- or 8-byte array Variant VBA
'   Byte2Hex Byte array           Hex string                 VBA

Sub AddDecimals()
Dim x As Integer
x = Application.InputBox("No of Decimals !!", "Add Decimals", Type:=2)
If x = 0 Then
Selection.NumberFormat = "0" & WorksheetFunction.Rept(0, x)
Else
Selection.NumberFormat = "0." & WorksheetFunction.Rept(0, x)
End If
End Sub

Sub ListFormulas()
    Dim FormulaCells As Range, Cell As Range
    Dim FormulaSheet As Worksheet
    Dim Row As Integer
    
'   Create a Range object for all formula cells
    On Error Resume Next
    Set FormulaCells = Range("A1").SpecialCells(xlFormulas, 23)
    
'   Exit if no formulas are found
    If FormulaCells Is Nothing Then
        MsgBox "No Formulas."
        Exit Sub
    End If
    
'   Add a new worksheet
    Application.ScreenUpdating = False
    Set FormulaSheet = ActiveWorkbook.Worksheets.Add
    FormulaSheet.Name = "Formulas in " & FormulaCells.Parent.Name
    
'   Set up the column headings
    With FormulaSheet
        Range("A1") = "Address"
        Range("B1") = "Formula"
        Range("A1:B1").Font.Bold = True
    End With
    
'   Process each formula
    Row = 2
    For Each Cell In FormulaCells
        Application.StatusBar = Format((Row - 1) / FormulaCells.Count, "0%")
        With FormulaSheet
            Cells(Row, 1) = Cell.Address _
                (RowAbsolute:=False, ColumnAbsolute:=False)
            Cells(Row, 2) = " " & Cell.Formula
            Row = Row + 1
        End With
    Next Cell
    
'   Adjust column widths
    FormulaSheet.Columns("A:B").AutoFit
    Application.StatusBar = False
End Sub

Sub SelectUnlockedCells()
    Dim WorkRange As Range
    Dim FoundCells As Range
    Dim Cell As Range
    Set WorkRange = ActiveSheet.UsedRange
    For Each Cell In WorkRange
        If Cell.Locked = False Then
            If FoundCells Is Nothing Then
                Set FoundCells = Cell
            Else
                Set FoundCells = Union(FoundCells, Cell)
            End If
        End If
    Next Cell
    If FoundCells Is Nothing Then
        MsgBox "All cells are locked."
    Else
        FoundCells.Select
    End If
End Sub

Sub DeleteBlankRows()


' Deletes the entire row within the selection if the ENTIRE row contains no data.
' Revised March 14, 2007 - added For/Next loop to ensure "empty appearing" cells are cleared.

On Error Resume Next

Dim i As Long
Dim c As Range, OrigRange As Range

    
With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
        
        
    ' Set original selection for later use
    Set OrigRange = Selection
    
' clear contents of seemingly empty cells that are really not empty

' This version formats text as general
    With ActiveSheet
        .UsedRange.Value = Evaluate("IF(ROW(" & .UsedRange.Address & "),CLEAN(" & .UsedRange.Address & "))")
    End With
            
' This version keeps cell formats as text
'    Selection.SpecialCells(xlCellTypeConstants, 23).Select
'
'    For Each c In Selection
'         If Len(c) = 0 Then c.ClearContents
'    Next c
      
    'Delete blank rows starting at bottom of selection
    For i = OrigRange.Rows.Count To 1 Step -1
        If WorksheetFunction.CountA(OrigRange.Rows(i)) = 0 Then
            OrigRange.Rows(i).EntireRow.Delete
        End If
    Next i
    
    Range("A1").Select

    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
End With

End Sub

Sub Filenames()
    
Dim sName As String, vNames(), sType As String, sPath As String, i As Long

' Change folder to suit
sPath = "C:\Documents and Settings\StephenR\"
ChDrive sPath
ChDir sPath

sType = "*.xls"
sName = Dir(sType)
Do Until sName = ""
    i = i + 1
    ReDim Preserve vNames(1 To i)
    vNames(i) = sName
    sName = Dir
Loop
If i = 0 Then
    MsgBox "No files found"
Else
    For i = 1 To UBound(vNames)
        Cells(i, 1) = vNames(i)
      ' To remove .xls suffix
      ' Cells(i, 1) = Left(vNames(i), Len(vNames(i)) - 4)
    Next i
End If
            
End Sub