Check to see if file exists before opening: VBA Excel

If FileOrFolderExists(Thisworkbook.Path & Application.PathSeparator & "auth.txt","txt") Then
     'the file exists, so it is on the company drive
Else
     'the file does not exist, so they must be working remotely
End If

Automatically add pagebreaks at interval: VBA Excel

Dim intCntRows As Integer
Dim intLastRow As Integer
intLastRow = ActiveSheet.UsedRange.End(xlDown).Row
intCntRows = 2
Do Until intCntRows = intLastRow
If InStr(ActiveSheet.Cells(intCntRows, 1), "=") > 0 And Range("A" & intCntRows).HasFormula = False Then
ActiveSheet.Rows(intCntRows + 1).PageBreak = xlPageBreakManual
End If
intCntRows = intCntRows + 1
Loop

Remove pagebreaks: VBA Excel

With ActiveSheet.PageSetup
.Zoom = False
.FitToPagesTall = 1
.FitToPagesWide = 1
End With

List all computer names and user names on a network: VBA Excel

Option Explicit
Private Declare Function GetComputerName Lib "kernel32" _
Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) _
As Long
Private Declare Function GetUserName Lib "advapi32.dll" _
Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) _
As Long
Public Function NameOfComputer()
     '   Returns the name of the computer
    Dim ComputerName As String
    Dim ComputerNameLen As Long
    Dim Result As Long
    ComputerNameLen = 256
    ComputerName = Space(ComputerNameLen)
    Result = GetComputerName(ComputerName, ComputerNameLen)
    If Result 0 Then
        NameOfComputer = Left(ComputerName, ComputerNameLen)
    Else
        NameOfComputer = "Unknown"
    End If
End Function
Function UserName() As String
     '   Returns the name of the logged-in user
    Dim Buffer As String * 100
    Dim BuffLen As Long
    BuffLen = 100
    GetUserName Buffer, BuffLen
    UserName = Left(Buffer, BuffLen - 1)
End Function
Sub show_computername()
    Dim pc_name As String
    pc_name = UCase(NameOfComputer)
    MsgBox ("This computer his name : " & pc_name)
End Sub
Sub show_username()
    Dim inlogname As String
    inlogname = UCase(UserName)
    MsgBox ("Inlogname user : " & inlogname)
End Sub

Extract & determine a workbook name from its file path: VBA Excel

Private Function StripFromPath(FullPath As String) As String ' Cut the file name out of a full path
Dim szStrip As String
Dim szFile As String
Dim i As Long
If Len(FullPath) > 0 Then
    szStrip = CStr(Empty)
    i = Len(FullPath)
    Do While szStrip "\"
        szStrip = Mid$(FullPath, i, 1)
        If szStrip = "\" Then
            szFile = Right$(FullPath, Len(FullPath) - i)
        End If
        i = i - 1
    Loop
    StripFromPath = szFile
End If

Drag and Drop (code is extracted from larger program): VBA Excel

Private Sub List2_BeforeDragOver(ByVal Cancel As _
    MSForms.ReturnBoolean, ByVal Data As _
    MSForms.DataObject, ByVal X As Single, _
    ByVal Y As Single, ByVal DragState As Long, _
    ByVal Effect As MSForms.ReturnEffect, _
    ByVal Shift As Integer)
    Cancel = True
    Effect = 1
End Sub

Private Sub List2_BeforeDropOrPaste(ByVal _
    Cancel As MSForms.ReturnBoolean, _
    ByVal Action As Long, ByVal Data As _
    MSForms.DataObject, ByVal X As Single, _
    ByVal Y As Single, ByVal Effect As _
    MSForms.ReturnEffect, ByVal Shift As Integer)
    Cancel = True
    Effect = 1
    List2.AddItem Data.GetText
End Sub

Private Sub List1_MouseMove(ByVal Button As _
     Integer, ByVal Shift As Integer, ByVal X As _
     Single, ByVal Y As Single)
    Dim MyDataObject As DataObject
    If Button = 1 Then
        Set MyDataObject = New DataObject
        Dim Effect As Integer
        MyDataObject.SetText List1.Value
        Effect = MyDataObject.StartDrag
    End If
End Sub

Determine datatype of contents in cell: VBA Excel

Function CellType(c)
'   Returns the cell type of the upper left
'   cell in a range
    Application.Volatile
    Set c = c.Range("A1")
    Select Case True
        Case IsEmpty(c): CellType = "Blank"
        Case Application.IsText(c): CellType = "Text"
        Case Application.IsLogical(c): CellType = "Logical"
        Case Application.IsErr(c): CellType = "Error"
        Case IsDate(c): CellType = "Date"
        Case InStr(1, c.Text, ":") 0: CellType = "Time"
        Case IsNumeric(c): CellType = "Value"
    End Select
End Function