Thread: What's in Your Personal.xls?

After using =Char(Mid(A1, 15, 1)), =Char(Mid(A1, 16, 1)), =Char(Mid(A1, 17, 1)), ... a few hundred times in years past, I made a form and wrote some code to list the contents of a cell in binary. It's been handy.

I recently added support for Unicode, so it may not be fully cooked (or maybe reheated), and double-width Unicode characters are problematic.

In addition to adding the attached form to the workbook, this needs to go in a code module.

Code:

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

I use these functions in lieu of the volatile constructs like this:

ROW(INDIRECT("1:" & A1))
COLUMN(INDIRECT(A1 & ":" & A2))

... like this:

RowArr(1, A1)
ColArr(A1, A2)

... with the added benefit of having a step variable

RowArr(1, 10, 2)

... and you can have negative numbers

RowArr(10, -5, -3)

Here 'tis.

Just thought I'd share ...

Ever wonder about how binary (IEEE-754) floating point numbers (the source of all those mysterious precision problems) are actually represented? The attachment has a family of functions for converting between floating point numbers and hex strings. I used a couple of these in responding to http://www.excelforum.com/excel-prog...h-queries.html.

Most work in either VBA or as worksheet functions. Here's the list:

Code:

'   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

My thought was that we could use this thread as a repository of sorts, and vector people here when one of the routines might solve a problem.

I have a macro listing names of files in a folder, and one which extracts data from files in a folder. I have a couple of template-style macros which contain little bits of code which I tend to use more often than most (e.g. Find).

I also have a number of very short macros which I’ve assigned to buttons on a toolbar. They’re so simple but they save so much time. For example, vertically centring text, removing colours, turning off AutoFilter, centring across selection, filling selected cells with random numbers.

Those sound great! How making a separate post for each?

So -- post 'em up, Stephen!

Mostly have a lot of little utility macros with shortcut keys if I use them often.
Here's one where I select all the cells in my workbook that I want to have a specific # of digits

Code:

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

And here's one that Inserts a worksheet and lists all the formulas off the active sheet and what cells they are in

Code:

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

I use this one a lot before protecting my workbook. It selects all unlocked cells.

Code:

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

Mine are mostly specific to my workplace, like changing Csv files to a nicely Formatted BOM form.. or actually consolidating quantities in CSV files to BOM's, etc..

But here is a simple one that I am sure people have already access to, I use to delete blank rows...

Code:

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

I just wanted to say I don't use a Personal.xls... adding no value to the thread per se just thought I should point out how odd I am... and wondered if anyone else out there like me... I do have a libary of exported modules (.bas) which I import to files as and when but that's about it (along with some old .xla's)...

Interesting thread... cheers shg.

You're in good company -- Andy Pope doesn't use one.

Maybe it's just because we're both "Essex Boys" ...
(I might live in Suffolk in the UK but I'm a born & bred Essex Boy... note to non-Brits - that's not a good thing in terms of sterotypes...)

I had a friend in Essex who was continually at pains to point out that he lived in the posh bit (which was virtually Suffolk).

Are we friends but don't know we're friends ??? Me too...
(If he was indeed a he, and he continuously referred to his hometown as the oldest recorded town & former Roman Capital of Britain (Camulodunum) and former home to Damon Albarn of Blur then there's a good chance we know each other...)

Promise I won't darken the thread further unless I have something worthy to add. Sorry.