WORKING WITH QTP

TestEveryThinG

FIND CELL Value in EXCEL VB

Posted by rajivkumarnandvani on April 25, 2009

Some Time we have to Check that particular Cell Value Exist or Not and required the Cell address
rem this function return the first  find Cell address  value of your Excel sheet  & Change Color of Cell find value
rem input parameter xlFilePath := xls file path || FindValue =value which need to be find

dim sXLpath , FindValue ,getCellAddress
sXLpath =”C:\RajivKumarNandvani.xls” rem define xls file path
FindValue =”Rajiv” rem check rajiv in cell exist or not
getCellAddress = FindCellAddress(sXLpath ,FindValue )
msgbox getCellAddress

Public function  FindCellAddress(Byval  xlFilePath ,byval FindValue )

Set ObjAppExcel = CreateObject(“Excel.Application”)
rem Disable alerts
ObjAppExcel.DisplayAlerts = False
r
em Add a workbook to the Excel App
ObjAppExcel.Workbooks.open(xlFilePath)
REm Get the object of the first sheet in the workbook
Set objectSheet = ObjAppExcel.Sheets(“Sheet1”)
rem define the range from A1 to last column address and filnd the value in range
set objValueFind = objectSheet.UsedRange.Find(FindValue)
If not objValueFind is nothing Then
CellAddress =objValueFind.address
FindCellAddress=replace(objValueFind.address,”$”,””)
FindCellAddress=replace( FindCellAddress,”1″,””)

Do

set objValueFind = objectSheet.UsedRange.FindNext(objValueFind )

Loop While Not objValueFind Is Nothing And objValueFind.Address <> CellAddress

Exit function

End If
rem if not found then return the Empty
FindCellAddress=”NOT FOUND”

Set objValueFind =nothing
Set objectSheet =nothing
Set ObjAppExcel =nothing
End Function

Advertisements

3 Responses to “FIND CELL Value in EXCEL VB”

  1. Sam said

    Hello Rajiv, Your script is really nice script and I am trying to achieve as follows,
    I have one excel sheet in that I have two columns A & B filled up with user names till row 34 in both and I want to write a script that will automatically pickup the cell value from A column and look for that value in column B and if found write the output “YES” in column C in front of the same row cell that it was searching.

    And I have modified ur script as per my need, but this script works perfect till row 16th row and from 17th row it starts wrong output. Could you pls help me where I could be wrong here? I would appreciate your help in this regards. Thanks
    ‘###########################
    dim introw, r, sXLpath , FindValue ,getCellAddress, AppExcel, worksheet, sheet
    Const ForReading = 1
    Const ForAppending = 8

    sXLpath = “C:\Find_Excel.xls”
    Set objExcel = CreateObject(“Excel.Application”)
    Set objAppExcel = CreateObject(“Excel.Application”)
    objappExcel.Workbooks.Open sXLpath ‘,,False
    Set objSheet = objappExcel.ActiveWorkbook.WorkSheets(1)
    Set objworkSheet = ObjAppExcel.Sheets(“Sheet1”)

    ‘ Skip the first row.
    intRow = 2
    Do until objAppexcel.Cells(intRow, 1).Value = “”
    ‘ Read values from columns 1 and 2.
    strValue1 = objappexcel.Cells(intRow, 1).Value
    strValue2 = objappexcel.Cells(intRow, 2).Value

    ‘$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
    FindValue = strValue1
    getCellAddress = FindCellAddress(sXLpath ,FindValue)

    ‘If getCellAddress.value = strValue2 Then
    ‘$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
    ‘ Write value to column 3.
    objappexcel.Cells(intRow, 3).value = getCellAddress

    introw = intRow + 1
    Loop

    AppExcel.ActiveWorkbook.Save ‘as sXLpath
    AppExcel.ActiveWorkbook.Close
    AppExcel.Application.Quit

    ‘##############################################
    Public function FindCellAddress(Byval xlFilePath ,byval FindValue )

    ‘rem Disable alerts
    ObjAppExcel.DisplayAlerts = False

    ‘rem Add a workbook to the Excel App
    ObjAppExcel.Workbooks.Open(sXLpath) ‘(xlFilePath)

    ‘REm Get the object of the first sheet in the workbook
    Set objectSheet = ObjAppExcel.Sheets(“Sheet1”)

    ‘rem define the range from A1 to last column address and find the value in range
    Set objValueFind = objectSheet.Range(“B1:B34″).Find(FindValue)

    If Not objValueFind is nothing Then
    CellAddress = objValueFind.address
    FindCellAddress = Replace(objValueFind.address,”$”,””)
    FindCellAddress = Replace(FindCellAddress,”1″,””)

    ‘MsgBox objValueFind.Address

    Do

    set objValueFind = objectSheet.Range(“B1:B34”).FindNext(objValueFind )

    ‘MsgBox objvaluefind

    ‘Loop While Not objValueFind Is Nothing And objValueFind.Address CellAddress
    Loop While Not objValueFind Is Nothing And objValueFind.Address CellAddress

    Exit function

    End If

    ‘rem if not found then return the Empty
    FindCellAddress = “NOT FOUND”

    Set objValueFind =nothing
    Set objectSheet =nothing
    Set ObjAppExcel =Nothing
    End Function
    ‘#############################################

  2. Sam said

    Hi I have modified it more and now it gives always valid values, but now this time problem is that it doesn’t write into excel. I can see the values in visible true mode, but it doesn’t write into excel cells and neither save those values. Could u pls help me?

    ‘@@@@@@@@@@@@@@@@@
    dim introw, r, sXLpath , FindValue ,getCellAddress, AppExcel, worksheet, sheet
    On Error Resume Next
    ‘On Error Goto 0

    Const ForReading = 1
    Const ForAppending = 8

    sXLpath = “C:\Find_Excel.xls”
    Set objAppExcel = CreateObject(“Excel.Application”)
    objappExcel.Workbooks.Open sXLpath,,False
    Set objSheet = ObjAppExcel.Sheets(“Sheet1”)
    objappexcel.Visible = True

    ‘ Skip the first row.
    intRow = 2

    Do Until objAppexcel.Cells(intRow, 1).Value = “”
    ‘ Read values from columns 1 and 2.
    strValue1 = objappexcel.Cells(intRow, 1).Value

    ‘$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
    FindValue = strValue1
    getCellAddress = FindCellAddress(sXLpath ,FindValue)
    ‘msgbox getCellAddress
    ‘$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
    ‘ Write value to column 3.
    If getCellAddress “” then ‘Is Nothing Then
    objappexcel.Cells(intRow, 3) = getCellAddress
    End If
    introw = intRow + 1
    Loop

    AppExcel.sheets.Save
    AppExcel.ActiveWorkbook.Close
    AppExcel.Application.Quit
    Set objappexcel = Nothing
    Set objsheet = Nothing
    WScript.Quit
    ‘##############################################
    Public function FindCellAddress(Byval sXLpath ,byval FindValue )

    ‘rem Disable alerts
    ObjAppExcel.DisplayAlerts = False

    ‘rem Add a workbook to the Excel App
    ObjAppExcel.Workbooks.Open(sXLpath) ‘(xlFilePath)

    ‘REm Get the object of the first sheet in the workbook
    Set objectSheet = ObjAppExcel.Sheets(“Sheet1”)
    ‘rem define the range from A1 to last column address and find the value in range
    ‘Set UsedRange = objexcel.Range(“B1:B50”).Find (strValue1)
    Set objValueFind = objectSheet.Range(“B1:B34″).Find(FindValue)

    CellAddress = objValueFind.address
    FindCellAddress = Replace(objValueFind.address,”$”,””)
    FindCellAddress = Replace(FindCellAddress,”1″,””)

    ‘MsgBox objValueFind.Address

    If objValueFind is nothing Then
    FindValue = Nothing
    Else

    Do
    Set objValueFind = objectSheet.Range(“B1:B34”).FindNext(objValueFind )
    ‘MsgBox objvaluefind

    Loop While Not objValueFind Is Nothing And objValueFind.Address CellAddress

    Exit function
    End If

    ‘rem if not found then return the Empty
    FindCellAddress = “nothing” ‘ “NOT FOUND”

    Set objValueFind =nothing
    Set objectSheet =nothing
    Set ObjAppExcel =Nothing
    End Function
    ‘#############################################

  3. Hi thanks for the comment
    I think the problem you facing in saving the record due your excel sheet open in Read only mode .Instead of save method use save as method and mention the file Location (not overwrite the same file Becos u can not ower write the file which is already open).

    and one more thing Before Run the script make sure all excel Process must be Null.Check through Task manager excel.exe instance
    For that Kill the Excel process by VB functon mentioned in my blog
    https://rajivkumarnandvani.wordpress.com/2009/05/03/close-application-process-qtp/

    Let me know if i am correct

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

 
%d bloggers like this: