‘bolSuccess=OpenAcess_RunMacro(”\\Myserver\Folder\AccessFile.mdb“, “MyMacro”)

   On Error GoTo OpenAcess_RunMacro_Error

    Set appAccess = CreateObject(”access.application”)
    appAccess.OpenCurrentDatabase AccessPathAndName
    appAccess.DoCmd.RunMacro MacroName
    Set appAccess = Nothing
  

  OpenAcess_RunMacro = True

   On Error GoTo 0
   Exit Function

OpenAcess_RunMacro_Error:
      MsgBox “Error ” & Err.Number & ” (” & Err.Description & “) in procedure OpenAcess_RunMacro ”
  End Function

Sort Range(”A2:C5″), “C”, xlAscending

End Sub

Sub Sort(DataRangeWithoutHeader As Range, ColumnLetterToSort As String, SortOrder As XlSortOrder)

Dim OriginalSelectedRange As Range
Dim keyRange As Range
Dim Column As Variant
Dim ColumnVisibility As New Collection

‘Remeber what was selected
Set OriginalSelectedRange = Selection

‘prevent user from watching the screen update
Application.ScreenUpdating = False

‘unhide any hidden cols and add to Collection Variable
For Each Column In DataRangeWithoutHeader.Columns
If Column.EntireColumn.Hidden = True Then
Column.EntireColumn.Hidden = False
ColumnVisibility.Add Column
End If
Next Column

‘clear
ActiveSheet.Sort.SortFields.Clear

’sort
Set keyRange = Range(ColumnLetterToSort & DataRangeWithoutHeader.Row & “:” & ColumnLetterToSort & DataRangeWithoutHeader.End(xlDown).Row)
ActiveSheet.Sort.SortFields.Add key:=keyRange, SortOn:=xlSortOnValues, order:=SortOrder, DataOption:=xlSortNormal
With ActiveSheet.Sort
.SetRange DataRangeWithoutHeader
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

‘put back any hidden columns
Do While ColumnVisibility.Count > 0
Set Column = ColumnVisibility.Item(1)
Column.EntireColumn.Hidden = True
ColumnVisibility.Remove (1)
Loop

‘Select the original range
OriginalSelectedRange.Select

‘Restore Default
Application.ScreenUpdating = True

End Sub

Sub Main()

     timeStart = GetTickCount
     ‘do something
     timeEnd = GetTickCount
     MsgBox timeEnd - timeStart & ” milliseconds”

End Sub

End Sub

Sub FormatRows(FindWhat As String, SearchRange As Range, formatColStart As String, formatColEnd As String)
    Dim OriginalSelectedRange As Range
    Dim firstFoundCell As Range
    Dim curFoundCell As Range
    Dim foundCell As Variant

On Error GoTo FormatRows_Error

    ‘Remeber what was selected
    Set OriginalSelectedRange = Selection
    ‘prevent user from watching the screen update
    Application.ScreenUpdating = False

    ’select range to search
    SearchRange.Select
       With Selection
        ‘try to find value
        Set foundCell = .Find(FindWhat, LookIn:=xlValues)
        ‘if a value was found in that selected range
        If Not foundCell Is Nothing Then
            ‘remember first found cell
            Set firstFoundCell = Range(foundCell.Address)
                Do
                ‘format
                Range((formatColStart & foundCell.Row) & “:” & (formatColEnd & foundCell.Row)).Font.Bold = True
                Range((formatColStart & foundCell.Row) & “:” & (formatColEnd & foundCell.Row)).Interior.ColorIndex = 3
                ‘try to find again
                Set foundCell = .FindNext(foundCell)
                ‘if a value was found in selected range AND its not the first found Cell
                If Not foundCell Is Nothing And foundCell.Address <> firstFoundCell.Address Then
                    Set curFoundCell = Range(foundCell.Address)
                Else
                     Exit Do
                End If
              Loop
      End If
      End With
    ‘Select the original range
    OriginalSelectedRange.Select
    ‘Restore Default
    Application.ScreenUpdating = True

On Error GoTo 0
   Exit Sub

FormatRows_Error:
    ‘Restore Default
    Application.ScreenUpdating = True
    MsgBox “Error ” & Err.Number & ” (” & Err.Description & “) in procedure FormatRows”
End Sub

    With rng
        ‘Style
        .Borders.LineStyle = xlSolid
        ‘None
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
        ‘Edge
        .Borders(xlEdgeLeft).LineStyle = xlSolid
        .Borders(xlEdgeTop).LineStyle = xlSolid
        .Borders(xlEdgeBottom).LineStyle = xlSolid
        .Borders(xlEdgeRight).LineStyle = xlSolid
    End With

End Sub

Function ColumnLetter(ColumnNumber As Integer) As String
   If ColumnNumber > 26 Then

    ‘ 1st character:  Subtract 1 to map the characters to 0-25,
    ‘                 but you don’t have to remap back to 1-26
    ‘                 after the ‘Int’ operation since columns
    ‘                 1-26 have no prefix letter

    ‘ 2nd character:  Subtract 1 to map the characters to 0-25,
    ‘                 but then must remap back to 1-26 after
    ‘                 the ‘Mod’ operation by adding 1 back in
    ‘                 (included in the ‘65′)

    ColumnLetter = Chr(Int((ColumnNumber - 1) / 26) + 64) & _
                   Chr(((ColumnNumber - 1) Mod 26) + 65)
  Else
    ‘ Columns A-Z
    ColumnLetter = Chr(ColumnNumber + 64)
  End If
 End Function

    RemoveSubtotals range(”1:900″)

End Sub

Sub RemoveSubtotals(rng As range)

On Errror GoTo oops
    With rng
        .Font.Bold = False
        .RemoveSubtotal
    End With
oops:
    On Error GoTo 0

End Sub

    AllBorders range(”g17:h17″)

End Sub

Sub AllBorders(rng As range)

    With rng
        ’style
        .Borders.LineStyle = xlSolid
        ‘none
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        ‘inside
        .Borders(xlInsideVertical).LineStyle = xlSolid
        .Borders(xlInsideHorizontal).LineStyle = xlSolid
        ‘edge
        .Borders(xlEdgeLeft).LineStyle = xlSolid
        .Borders(xlEdgeTop).LineStyle = xlSolid
        .Borders(xlEdgeBottom).LineStyle = xlSolid
        .Borders(xlEdgeRight).LineStyle = xlSolid
    End With

End Sub

Function WorkSheetExists(xlWkshtName As String) As Boolean
       Dim xlWksht As Worksheet
       WorkSheetExists = False
   On Error Resume Next
        Set xlWksht = Worksheets(xlWkshtName)
   On Error GoTo 0
       If Not xlWksht Is Nothing Then
         WorkSheetExists = True
    End If
   End Function