Excel Automation

Copy an excel sheet to another excel

Set objExcel = CreateObject(“Excel.Application”)
objExcel.Visible = True
Set objWorkbook1= objExcel.Workbooks.Open(“C:\Documents and Settings\mohan.kakarla\Desktop\1.xls”)
Set objWorkbook2= objExcel.Workbooks.Open(“C:\Documents and Settings\mohan.kakarla\Desktop\2.xls”)
objWorkbook1.Worksheets(“Sheet1″).UsedRange.Copy
objWorkbook2.Worksheets(“Sheet1″).Range(“A1″).PasteSpecial Paste =xlValues
objWorkbook1.save
objWorkbook2.save
objWorkbook1.close
objWorkbook2.close
set objExcel=nothing

Compare 2 Excel sheets cell by cell

Set objExcel = CreateObject(“Excel.Application”)
objExcel.Visible = True
Set objWorkbook1= objExcel.Workbooks.Open(“C:Documents andSettingsmohan.kakarlaDesktopDocs1.xls”)

Set objWorkbook2= objExcel.Workbooks.Open(“C:Documents and
Settingsmohan.kakarlaDesktopDocs2.xls”)

Set objWorksheet1= objWorkbook1.Worksheets(1)
Set objWorksheet2= objWorkbook2.Worksheets(1)
   For Each cell In objWorksheet1.UsedRange
       If cell.Value <> objWorksheet2.Range(cell.Address).Value Then
           cell.Interior.ColorIndex = 3 'Highlights in red color if any changes in cells
       Else
           cell.Interior.ColorIndex = 0
       End If
   Next
set objExcel=nothing

DELETE ROWS FROM Excel SHEET

Set oExcel = CreateObject(“Excel.Application”)
oExcel.DisplayAlerts = False'Open Book in Excel
Set oBook = oExcel.Workbooks.Open(sSrcPath)'Set Activesheet
Set oSheet = oExcel.Activesheet'Delete row range
oSheet.Rows(sStartRow +”:”+ sEndRow).Delete'Save new book to Excel file
oBook.SaveAs (sDestPath)

'Close the xls file
oExcel.Workbooks.Close()

DELETE Columns FROM Excel SHEET

Set oExcel = CreateObject(“Excel.Application”)
oExcel.DisplayAlerts = False'Open Book in Excel
Set oBook = oExcel.Workbooks.Open(sSrcPath)
'Set Activesheet
Set oSheet = oExcel.Activesheet

'Delete row range
oSheet.Columns(sStartCol + “:” + sEndCol).Delete'Save new book to Excel file
oBook.SaveAs (sDestPath)'Close the xls file
oExcel.Workbooks.Close()


Search for a particular value an excel


Set appExcel = CreateObject(“Excel.Application”)
appExcel.visible=true

Set objWorkBook = appExcel.Workbooks.Open (filepath) 'opens the sheet
Set objSheet = appExcel.Sheets(“Sheet1″) 'To select particular sheet

With objSheet.UsedRange 'select the used range in particular sheet
   Set c = .Find (“nn”) 'data to find
For each c in objSheet.UsedRange 'Loop through the used range
 If c=”nn” then 'compare with the expected data
        c.Interior.ColorIndex = 40 'make the gary color if it finds the data
End If
   Set c = .FindNext(c) 'next search

next
End With

objWorkBook.save
objWorkBook.close
set appExcel=nothing

Sort a Column in Ascending/Descending order


Const xlAscending=1
Const xlDescending=2
Const xlYes=1

ExlPath="D:\Scheduler.xlsx"
Set excel=CreateObject("Excel.Application")
excel.DisplayAlerts=true
excel.visible=true

Set objWorkbook= excel.Workbooks.Open(ExlPath)
Set objWorkSheet=objWorkbook.Worksheets(1)

Set ExcelRange= objWorkSheet.UsedRange
Set xy =objWorkSheet.Range("A1")
ExcelRange.Sort xy,xlDescending, , , , , ,1

objWorkbook.save
objWorkbook.Close
Set objWorkbook= Nothing
Set objWorkSheet= Nothing
Set ExcelRange= Nothing
excel.Application.Quit
Set excel= Nothing


Save any open excel file to the given path


Function func_SaveAnyOpenExcel(sheetPath)
 Dim pathName
 pathName=sheetPath

 'Create shell object
 Set wshObj = CreateObject("Wscript.Shell")
 wait 1
 wshObj.SendKeys "%{F4}"
 wait 1
 wshObj.SendKeys "~"
 wait 2
 wshObj.SendKeys pathName
 wait 2
 wshObj.SendKeys "~"
 Wait 2
 Set wshObj = Nothing

End Function


Converts a CSV file to an excel file and returns the excel file path


Function func_ConvertCSV_To_Excel(srcFileName)

 On Error Resume Next
 Set fso=Createobject("Scripting.FileSystemObject")

 If (fso.FileExists(srcFileName)) Then
  'Convert the path file to ".xls" which will be used to save the excel file
  tgtFileName=Replace(srcFileName,".csv",".xls")

  Set objExcel = CreateObject("Excel.application")
  set objExcelBook = objExcel.Workbooks.Open(srcFileName)

  objExcel.application.visible=false
  objExcel.application.displayalerts=false

  objExcelBook.SaveAs tgtFileName, 23
  objExcel.Application.Quit
  objExcel.Quit  

  Set objExcel = Nothing
  set objExcelBook = Nothing
  Set fso=Nothing

  'Return the file path
  func_ConvertCSV_To_Excel=tgtFileName
 Else
    Reporter.ReportEvent micFail, "Convert CSV to Excel file process", "CSV file does not exist, hence could not be converted"
 End If

 If  Err.Number <> 0  then 

  Reporter.ReportEvent micWarning, "Error occured in Function- ' <<func_Search_UniqueValue_Excel>>' get failed","Error description: "& Err.Description & vblf & "Error number: " & Err.Number
 End IF

End Function