Thread: What's in Your Personal.xls?

A couple of functions that I find useful:

Range

Code:

Function range(a As range)
mmax = Application.WorksheetFunction.Max(a)
mmin = Application.WorksheetFunction.Min(a)
spread = Abs(mmax - mmin)
End Function

Multi cell concatenate

Code:

 
Function conc(a As range)
Dim rcell As range, tmp As String
For Each rcell In a
tmp = tmp & rcell.Value & " "
Next
conc = tmp
End Function

interrogate cell colour

Code:

 
Function fillcolour(a As range)
b = a.Interior.ColorIndex
fillcolour = b
End Function

interrogate cell formula

Code:

Function form(a As range)
form = a.Formula
End Function

Upper and Lower control limits:

Code:

 
Function UCL(dat As range)
avg = Application.WorksheetFunction.Average(dat)
sd3 = Application.WorksheetFunction.StDev(dat) * 3
UCL = avg + sd3
End Function
 
Function LCL(dat As range)
avg = Application.WorksheetFunction.Average(dat)
sd3 = Application.WorksheetFunction.StDev(dat) * 3
LCL = avg - sd3
End Function

Note that these are just to "get by" and don't error trap (and probably aren't particularly well written)

Dave

DonkeyOte: oh my God I can't believe it, you're ... well it is uncanny except that my friend would have had difficulty spelling Excel never mind penetrating the mysteries of VBA. So, Damon Albarn left Essex did he once he made some money...who'd have thought it.

Apologies to shg for derailing his thread.

Thanks sweep - what do you use UCL and LCL for?

Thanks sweep - what do you use UCL and LCL for?

I used to use it all the time for control limits on XBar & R charts. However, no I have Minitab, it's not used so often...

As I regulary use workbooks with many sheets, and often hide a number of sheets from time to time I find the below useful.

Code:

Sub UnHideSheets()
For Each Sheet In ActiveWorkbook.Sheets
    If Sheet.Visible = False Then Sheet.Visible = True
Next
    
End Sub

I store the macros I've pinned to keyboard shortcuts in one module. I start them all ok (OnKey) so they're easy to discern/ignore in larger lists:
Assigning the macros to various application.onkey strings is done in my personal.xls workbook open event.

Code:

Sub okRefitColumns()
    Columns.AutoFit
End Sub

Sub okCAGeneral()
    If Selection.HorizontalAlignment = xlCenterAcrossSelection Then
        Selection.HorizontalAlignment = xlGeneral
    Else
        Selection.HorizontalAlignment = xlCenterAcrossSelection
    End If
End Sub

Sub okDuplicateRow()
    Application.ScreenUpdating = False
    With ActiveCell.EntireRow
        .Copy
        .Insert
    End With
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
End Sub

Sub okDuplicateRowRev()
    On Error Resume Next
        ActiveCell(2).EntireRow.Delete
    On Error GoTo 0
End Sub

Sub okColourCycle()
With Selection.Interior
    Select Case .ColorIndex
        Case -4142: .ColorIndex = 35
        Case 35: .ColorIndex = 39
        Case 39: .ColorIndex = 36
        Case 36: .ColorIndex = 37
        Case 37: .ColorIndex = 40
        Case 40: .ColorIndex = 34
        Case 34: .ColorIndex = 38
        Case Else: .ColorIndex = Null
    End Select
End With
End Sub

I find the last of these very useful. Whilst working on a sheet, I can quickly colour cells needing special attention for any reason (I have pinned it to ctrl+g as I use Go To very rarely). The cycle is very powerful, once for green, twice for purple, etc. is super quick. Any "mixed" group is blanked first, then coloured (which can be quite helpful depending on which colour-happy mentalist sent you the sheet you're working on).

CC

You should make the two column list a named range so you wouldn't need to bother with that first bit... oh wait...

I wrote this recently, trying to decipher a really mixed up worksheet, with multiple different formulae at different points in columns & rows.
The comments show exactly how it works, but in summary, it returns true if the formulae of the two specified cells are equivalent (based on relative referencing, of course).

Code:

Function compare(Cell1 As range, cell2 As range)
    If Not Cell1.HasFormula And Not cell2.HasFormula Then
        'Neither have formulae, don't compare values, automatic pass
        compare = True
    ElseIf Cell1.HasFormula And cell2.HasFormula Then
        'Both have formulae, compare formulae
        compare = Cell1.FormulaR1C1 = cell2.FormulaR1C1
    Else
        'One has formula, one not, automatic fail
        compare = False
    End If
End Function