Function: GetColumnWithCellText

This function returns the first column number which contains the given search string when operated in mode '1' & gives the cell co-ordinates of all the cell containing the given string when operateed in mode '2'



Public Function GetColumnWithCellText (TableObject,SearchString,OperationMode)
RowCount = TableObject.RowCount
For irow = 1 to RowCount
ColumnCount = TableObject.ColumnCount(irow)
For icol = 1 to ColumnCount
CellData = TableObject.GetCellData(irow, icol)
If Strcomp(CellData, SearchString, 1) = 0 Then
If flag <> 1 Then
flag = 1
FirstColumn = icol
End If
If len(HitsList) <> 0 Then
HitsList = HitsList& ";"
End if
HitsList = HitsList & "(" & irow & "," & icol & ")"
End If
NextNext
If OperationMode = 1 Then
' Return first column mode
GetColumnWithCellText = FirstColumn Else
If OperationMode = 2 Then
' Return All Cells containing the search string
GetColumnWithCellText = HitsList
Else GetColumnWithCellText = "Invalid Operation Mode"
End If
End If

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*****************