Macros
- Check to see if a Macro Exists in CodeModule of a Worksheet.[1]
'=================================================================================
'- 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
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 access to the Worksheet, effectively turning the Protections off.
'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
- Disables access to the Worksheet, effectively turning Protections On
'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
References
- ↑ Brian Baulsom (October 2007). "Programming In The VBA Editor".