Excel Macro - Create Pivot Table & Chart.

Here the data which will be used for creating the pivot table and cahrt is stored in a worksheet calles "Action1".

Sub CreatePivotTable()
' CreatePivotTable Macro'
' Keyboard Shortcut: Ctrl+Shift+F

FinalColumn = 9
' The final column which contains data in the excelsheet

Row = Sheets("Action1").UsedRange.Rows.Count
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"Action1!R1C1:R" & Row & "C"&FinalColumn).CreatePivotTable TableDestination:=""_
,TableName:= "PivotTable1", DefaultVersion:=xlPivotTableVersion10

ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select

With ActiveSheet.PivotTables("PivotTable1").PivotFields("PROJECT_ID")
.Orientation = xlColumnField
.Position = 1
End With

With ActiveSheet.PivotTables("PivotTable1").PivotFields("PS_NAME")
.Orientation = xlRowField
.Position = 1
End With

ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _ "PivotTable1").PivotFields("HOURS"), "Sum of HOURS", xlSum

For Each wksht In ActiveWorkbook.Worksheets
If StrComp(wksht.Name, "Action1", 1) <> 0 Then
PivotSheet = wksht.Name
End If
Next wksht

' Create Pivot Chart
ActiveSheet.UsedRange.Select
Charts.Add
ActiveChart.SetSourceData Source:=Sheets(PivotSheet).UsedRange
ActiveChart.Location Where:=xlLocationAsNewSheet

End Sub

SendMail Function (using local Lotus Notes session)

Public Function SendMailLotusSession (ToAddress,CcAddress,EmailSubject, EmailBody, AttachmentAbsolutePath)

set s = createobject("Notes.NotesSession")
if s Is Nothing then
SendMailLotusSession = "Could Not Create A Session Of Notes"
endMe
exit Function
end if
If Err.Number <> 0 Then
On Error GoTo 0
SendMailLotusSession= "Could not create session 'Lotus Notes' from object
endMe
exit Function
end if
set db = s.getdatabase(s.getenvironmentstring("MailServer",True),s.getenvironmentstring("Mailfile",true))

If Err.Number <> 0 Then
On Error GoTo 0
SendMailLotusSession = "Could find or get a handle on the mail file
endMe
exit Function
end if
set doc = db.createdocument
set rtitem = doc.createrichtextitem("BODY")
with doc
.form = "Memo"
.subject = EmailSubject
.sendto = ToAddress

If len(CcAddress) > 0 Then
.copyto = CcAddress
End If
.body = EmailBody
.postdate = Date
end with
If len(AttachmentAbsolutePath) > 0 Then
set fs = createobject("Scripting.FileSystemObject")
path = fs.GetAbsolutePathName(AttachmentAbsolutePath)
if Not fs.FileExists(path) then
SendMailLotusSession = "File does not exist in directory you specified"
endMe
Exit Function
end if

call rtitem.embedobject(1454,"",AttachmentAbsolutePath)
End If
doc.visible = true
doc.send true
SendMailLotusSession = "You message has been created and sent." & chr(13) & "Thank you."
endMe
End Function
sub endMe()
'clean objects/memory
set s = nothing set db = nothing
set doc = nothing
set rtitem = nothing
set fs = nothing
end sub

Prob St: To edit cells in excelsheet and password protect all used cells (Using VBScript)

1. Select all cells in the excelsheet. right click, go to 'Format cells' uncheck 'Locked' in protection tab.
2. Protect the excelsheet using
3. Then use the following code in the vbscript to accomplish the task.

'*********************************************

Set objExcel = CreateObject("EXCEL.APPLICATION")
Set objWorkBook = objExcel.Workbooks.Open(FilePath)

objExcel.Activesheet.Unprotect "yourpassword "

' Enter you working code here

objExcel.ActiveSheet.UsedRange.Locked = true
'objExcel.Activesheet.protect "yourpassword "

'******************* end of script*****************