Excel 2010/Snippets/Worksheet

Macros
'================================================================================= '- CHECK IF A MODULE & SUBROUTINE EXISTS '- VBA constant : vbext_pk_Proc = All procedures other than property procedures. '- An error is generated if the Module or Sub does not exist - so we trap them. '- '- VB Editor : Tools/References - add reference TO ...... '-  .... "Microsoft Visual Basic For Applications Extensibility" '-- '- Brian Baulsom October 2007 '- http://www.cpearson.com/excel/vbe.aspx '================================================================================== Function MacroExists(ws As Worksheet, proc As String) As Boolean Dim cmod As VBIDE.CodeModule Dim num As Long  'max lines in a codemodule Dim procname As String Dim curwb As Workbook: Set curwb = ws.Parent On Error Resume Next Set cmod = curwb.VBProject.VBComponents(ws.CodeName).CodeModule On Error GoTo 0
 * Check to see if a Macro Exists in CodeModule of a Worksheet.

num = cmod.CountOfDeclarationLines + 1 Do Until num >= cmod.CountOfLines procname = cmod.ProcOfLine(num, VBIDE.vbext_pk_Proc) num = cmod.ProcStartLine(procname, vbext_pk_Proc) + cmod.ProcCountLines(procname, vbext_pk_Proc) + 1 If procname = proc Then MacroExists = True Exit Function End If  Loop

MacroExists = False End Function

UniqueValues

 * Returns a Variant Array of values that are unique to the specified Range @col.

'@ws - Worksheet Object '@col - String value, The Column Range value to be searched for Unique Values. 'Notes: ' - @col should ideally be a single column/row to have Values looked at for Cingularity. Function UniqueValues(ws As Worksheet, col As String) As Variant Dim rng As Range: Set rng = ws.Range(col) Dim dict As New Scripting.Dictionary If Not (rng Is Nothing) Then Dim cell As Range, val As String For Each cell In rng.Cells val = CStr(cell.Value) If Not dict.Exists(val) Then dict.Add val, val End If     Next cell End If  'Return value UniqueValues = dict.Items End Function

Protections
'Enables/Unprotects a Worksheet '@ws - Worksheet Object 'Returns: XlEnableSelection value 'Notes: ' - Makes a Worksheet Editable/Unprotected to operate with. '  - Returns XlEnableSelection value for state retention for later lock-down. Function EnableSelect(ws As Worksheet) As XlEnableSelection Dim ret As XlEnableSelection ret = ws.EnableSelection ws.EnableSelection = xlNoRestrictions EnableSelect = ret End Function
 * Enables access to the Worksheet, effectively turning the Protections off.

'Disables/Protects a Worksheet '@ws - Worksheet Object '@sel - XlEnableSelection value 'Notes: ' - @sel is the return value from "EnableSelect" Sub DisableSelect(ws As Worksheet, sel As XlEnableSelection) ws.EnableSelection = sel End Sub
 * Disables access to the Worksheet, effectively turning Protections On