Compare two excel worksheets

Sub Compare()
'
' Macro1 Macro
'
' compare two different worksheets in the active workbook
  CompareWorksheets Worksheets("Sheet1"), Worksheets("Sheet2")
End Sub

Sub CompareWorksheets(ws1 As Worksheet, ws2 As Worksheet)
  Dim diffB As Boolean
  Dim r As Long, c As Integer, m As Integer
  Dim lr1 As Long, lr2 As Long, lc1 As Integer, lc2 As Integer
  Dim maxR As Long, maxC As Integer, cf1 As String, cf2 As String
  Dim rptWB As Workbook, DiffCount As Long
  Application.ScreenUpdating = False
  Application.StatusBar = "Creating the report..."
  Application.DisplayAlerts = True
  With ws1.UsedRange
    lr1 = .Rows.Count
    lc1 = .Columns.Count
  End With
  With ws2.UsedRange
    lr2 = .Rows.Count
    lc2 = .Columns.Count
  End With
  maxR = lr1
  maxC = lc1
  If maxR < lr2 Then maxR = lr2
  If maxC < lc2 Then maxC = lc2
  DiffCount = 0
  For c = 1 To maxC
    For i = 2 To lr1
      diffB = True
      Application.StatusBar = "Comparing cells " & Format(i / maxR, "0 %") & "..."
        For r = 2 To lr2
          cf1 = ""
          cf2 = ""
          On Error Resume Next
          cf1 = ws1.Cells(i, c).FormulaLocal
          cf2 = ws2.Cells(r, c).FormulaLocal
          On Error GoTo 0
          If cf1 = cf2 Then
            diffB = False
            ws1.Cells(i, c).Interior.ColorIndex = 19
            ws1.Cells(i, c).Select
            Selection.Font.Bold = True
            Exit For
          End If
        Next r

     If diffB Then
       DiffCount = DiffCount + 1
       ws1.Cells(i, c).Interior.ColorIndex = 0
       ws1.Cells(i, c).Select
       Selection.Font.Bold = False
     End If
    Next i
  Next c
Application.StatusBar = "Formatting the report..."
'Columns("A:IV").ColumnWidth = 10
m = maxR - DiffCount - 1
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox m & " cells contain same values!", vbInformation, _
"Compare " & ws1.Name & " with " & ws2.Name
End Sub

Converts the Excel column number to its string equivalent

'//Converts the Excel column number to its string equivalent

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

Cheaks the given file is there in specified location

'Cheaks the given file is there in specified location
Function DoesFileExist(strFileSpec As String) As Boolean
' Return True if file specified in the
' strFilespec argument exists.
' Return False if strFileSpec is not a valid
' file or if strFileSpec is a directory.
Const INVALID_ARGUMENT As Long = 53
On Error GoTo DoesfileExist_Err
If (GetAttr(strFileSpec) And vbDirectory) <> vbDirectory Then
DoesFileExist = CBool(Len(Dir(strFileSpec)) > 0)
Else
DoesFileExist = False
End If
DoesfileExist_End:
Exit Function
DoesfileExist_Err:
DoesFileExist = False
Resume DoesfileExist_End
End Function

Browse the file

'Browse the file
Sub BrowseNewFile()
Dim filename
Dim wksh As Excel.Worksheet

Set wksh = ActiveWorkbook.Worksheets("dashboard")

'Opens browse dialog box to browse the template
filename = Application.GetOpenFilename("Excel Files(*.xls), *.*", , "Select any file in the desired folder to catch the path.")
If Not filename = "" Then
wksh.Cells(9, 1).Value = filename
End If
End Sub

Accessing OUTLOOK Unread mails from Word using VBA

'Download all Unread mails from outlook to word and format it into a table
'Make sure Outlook reference added.( tools -> references -> Microsoft outlook)
Sub DownloadMails()
Dim wordApp As Words
Dim myMailFolder As MAPIFolder
'Creating outlook appliction
Set objApp = CreateObject("Outlook.Application")
'Getting outlook inbox folder
Set myMailFolder = objApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
'Total number of mails in the inbox
Count = myMailFolder.Items.Count

Set wodDoc = ActiveDocument
wodDoc.Content = ""

Set myRange = wodDoc.Content

'display all Unreaded mails
i = 0
While i < Count
i = i + 1
With myMailFolder.Items(i)
If (.UnRead) Then
myRange.InsertAfter .Subject & "|" & .ReceivedTime & "|" & .SenderName & "|" & .SenderEmailAddress
wodDoc.Content.InsertParagraphAfter
myRange.InsertAfter "---------------------------------------------------------------------------------------------"
wodDoc.Content.InsertParagraphAfter
myRange.InsertAfter .Body
wodDoc.Content.InsertParagraphAfter
myRange.InsertAfter "---------------------------------------END OF THE MESSAGE------------------------------------"
wodDoc.Content.InsertParagraphAfter
End If
End With
Wend

End Sub

Accessing OUTLOOK tasks from Word using VBA

'It is a macro written in VBA (copy the code into VBA macro module).
'Download all tasks in out look and format it into a table
Sub DownloadTasks()
Dim wordApp As Words
'Dim objTask As TaskItem
Dim myTaskFolder As MAPIFolder
Set objApp = CreateObject("Outlook.Application")
Set objTask = objApp.CreateItem(olTaskItem)
Set myTaskFolder = objApp.GetNamespace("MAPI").GetDefaultFolder(olFolderTasks)
Count = myTaskFolder.Items.Count
'Task = myTaskFolder.Items.GetFirst
Set wodDoc = ActiveDocument
wodDoc.Content = ""
Dim myItem As Object

Set myItems = myTaskFolder.Items
Set myRange = wodDoc.Content

myRange.InsertAfter "Task Name" & ": " & "Due Date" & ": " & "Start Date"
wodDoc.Content.InsertParagraphAfter
'display all tasks
For Each myItem In myItems
Set myRange = wodDoc.Content
myRange.InsertAfter myItem & ": " & myItem.DueDate & ": " & myItem.StartDate
wodDoc.Content.InsertParagraphAfter
Next
Call Format

____________________________________________________________________
End Sub
'format the downloaded tasks to a table
Sub Format()
Selection.WholeStory
Selection.ConvertToTable Separator:=wdSeparateByDefaultListSeparator, _
AutoFitBehavior:=wdAutoFitContent
With Selection.Tables(1)
.Style = "Table Grid"
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = True
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = True
End With
End Sub