Excel Functions

generic_table.vb

Sub generic_table()
'
' generic_table Macro
'
' Keyboard Shortcut: Ctrl+m
'
    ActiveCell.FormulaR1C1 = "Chart Title"
    Range("A1").Select
    With Selection.Font
        .Name = "Garamond"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With Selection.Font
        .Name = "Garamond"
        .Size = 18
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Selection.Font.Bold = True
    Range("A1:F1").Select
    With Selection
        .HorizontalAlignment = xlCenterAcrossSelection
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Rows("2:2").Select
    Selection.RowHeight = 4
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "Title"
    Range("A3:F3").Select
    Selection.FillRight
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Font.Bold = True
    Rows("4:4").Select
    Selection.RowHeight = 4
    Range("A5:F5").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=MOD(ROW($A5),2)"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.799981688894314
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    Selection.Copy
    Range("A5:F21").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("A5").Select
    Application.CutCopyMode = False
End Sub

regex.vb

Function RegexFind(Value As String, Pattern As String, Optional Instance As Integer = 1, Optional IgnoreCase As Boolean = False)
    Dim r As New VBScript_RegExp_55.RegExp
    Dim MatchString As String
    Dim Counter As Integer
    Counter = 1
    r.Pattern = Pattern
    r.IgnoreCase = IgnoreCase
    r.Global = True
    Set Matches = r.Execute(Value)
    For Each Match In Matches
            MatchString = Match.Value
            If Counter = Instance Then GoTo Result
            Counter = Counter + 1
    Next
    MatchString = ""
Result:
    RegexFind = MatchString
End Function
Function RegexReplace(Value As String, Pattern As String, Replacement As String, Optional IgnoreCase As Boolean = False)
    Dim r As New VBScript_RegExp_55.RegExp
    r.Pattern = Pattern
    r.IgnoreCase = IgnoreCase
    r.Global = True
    RegexReplace = r.Replace(Value, Replacement)
End Function
Function RegexYears(Value As String)
    Dim r As New VBScript_RegExp_55.RegExp
    Dim Current As String
    Dim Minimum As String
    Dim Maximum As String
    Current = 0
    Minimum = 3000
    Maximum = 0
    r.Pattern = "[1-2][0-9]{3}"
    r.IgnoreCase = True
    r.Global = True
    Set Matches = r.Execute(Value)
    For Each Match In Matches
        Current = Match.Value
        If Current < Minimum Then Minimum = Current
        If Current > Maximum Then Maximum = Current
    Next
    If Minimum = Maximum Then
        RegexYears = Minimum
    Else
        RegexYears = Minimum & "-" & Maximum
    End If
End Function