Excel VBA: Insert or duplicate column to the left or right of selected cell

Public Sub InsertColumnToTheLeft()
    ActiveCell.EntireColumn.Insert
End Sub

Public Sub InsertColumnToTheRight()
    ActiveCell.Offset(, 1).EntireColumn.Insert
End Sub

Public Sub DuplicateColumnToTheLeft()
    ActiveColumn = ActiveCell.column
    InsertColumnToTheLeft
    CopyColumn ActiveColumn + 1, ActiveColumn
End Sub

Public Sub DuplicateColumnToTheRight()
    ActiveColumn = ActiveCell.column
    InsertColumnToTheRight
    CopyColumn ActiveColumn, ActiveColumn + 1
End Sub

Public Sub CopyColumn(SourceColumn, TargetColumn)
    FinalRow = Cells(Rows.Count, SourceColumn).End(xlUp).Row
    
    For Row = 1 To FinalRow
        Cells(Row, TargetColumn).Value = Cells(Row, SourceColumn).Value
    Next
End Sub

How to find paragraph under cursor in PowerPoint 2010 VBA

The following VBA function returns paragraph under cursor in Microsoft PowerPoint 2010:

Function GetParagraphUnderCursor() As TextRange2
    On Error Resume Next
    First = ActiveWindow.Selection.TextRange.Start
    If Err.Number <> 0 Then
        Exit Function
    End If
    On Error GoTo 0
    
    Set ShapeRange = ActiveWindow.Selection.ShapeRange
    If (1 = ShapeRange.Count) And (14 = ShapeRange(1).Type) And (ShapeRange(1).HasTextFrame) Then
        For Each Paragraph In ShapeRange(1).TextFrame2.TextRange.Paragraphs
            If (Paragraph.Start <= First) And ((Paragraph.Start + Paragraph.Length - 1) >= First) Then
                Set GetParagraphUnderCursor = Paragraph
                Exit Function
            End If
        Next Paragraph
    End If
End Function


Sub Test()
    Dim Paragraph As TextRange2
    Set Paragraph = GetParagraphUnderCursor()
    If Paragraph Is Nothing Then
        MsgBox "No text selected!"
    Else
        MsgBox Paragraph.Text
    End If
End Sub