Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Excel find/add

Status
Not open for further replies.

Woolers

Technical User
Jan 11, 2005
56
GB
Hi Guys,

I have the following script that looks in 1 excel sheet, then looks in another sheet for a matching server name, then will append certain information if found.

I think it's working fine, but wondered if there was a quicker way to check as it runs quite slowly?
Perhaps there's a better way of checking in excel?

Code:

Set objExcel = CreateObject("Excel.Application")
Set objExcel2 = CreateObject("Excel.Application")
objExcel.Visible = False
objExcel.DisplayAlerts = False
objExcel2.Visible = False
objExcel2.DisplayAlerts = False

'/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

strNewPath = "blah.xlsx"

Set objWorkbook1 = objExcel.Workbooks.Open("blah.xlsx")
Set objWorksheet1 = objWorkbook1.Worksheets(1)

Set objWorkbook2 = objExcel2.Workbooks.Open("blah.xlsx")
Set objWorksheet2 = objWorkbook2.Worksheets(1)

'/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

iRow = 2
introw = 2
Do Until objWorksheet1.Cells(intRow, 1).Value = ""
strValue = LCase(objWorksheet1.Cells(intRow, 1).Value)
strApp = objWorksheet1.Cells(intRow,4).Value
strOwner = objWorksheet1.Cells(intRow,8).Value
Wscript.Echo strValue & vbtab & strApp & vbtab & strOwner
Call CheckSecond(strValue, strApp, strOwner)
introw = introw + 1
Loop

'/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

objWorkBook1.Close
objExcel.Quit
set objExcel=nothing
objWorkbook2.SaveAs strNewPath
objWorkBook2.Close
objExcel2.Quit
set objExcel2=nothing

'/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

Function CheckSecond(strValue, strApp, strOwner)
iRow = 2
Wscript.Echo VbTab & "Searching For: " & strValue
Do Until iRow = 982
Val = LCase(strValue)
celltocheck = objWorksheet2.Cells(iRow, 1).Value
iRow = iRow + 1
If Instr(celltocheck,Val) Then
Wscript.Echo VbTab & "Found: " & celltocheck & " Row (" & iRow & ")"
objWorksheet2.Cells(iRow,11).Value = strApp
objWorksheet2.Cells(iRow,12).Value = strOwner
iRow = iRow + 1
End If
Loop
End Function


 
I'd assign one and only one Excel Application Object.

The rest of you blah stuff is not making sense as it seems you've got the same workbook/worksheet open.

Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
 
Sorry, let me clarify:

strNewPath = "DestinationWorksheet.xlsx"

Set objWorkbook1 = objExcel.Workbooks.Open("TargetWorksheet.xlsx")
Set objWorksheet1 = objWorkbook1.Worksheets(1)

Set objWorkbook2 = objExcel2.Workbooks.Open(strNewPath)
Set objWorksheet2 = objWorkbook2.Worksheets(1)
 
I'd assign one and only one Excel Application Object.
Code:
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False
objExcel.DisplayAlerts = False

'/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
'/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

strNewPath = "DestinationWorksheet.xlsx"

Set objWorkbook1 = objExcel.Workbooks.Open("TargetWorksheet.xlsx")
Set objWorksheet1 = objWorkbook1.Worksheets(1)

Set objWorkbook2 = objExcel.Workbooks.Open(strNewPath)
Set objWorksheet2 = objWorkbook2.Worksheets(1)

Are there more than one values to match in worksheet2? If not, then why continue the loop in the called function. In that case EXIT
Code:
'
Function CheckSecond(strValue, strApp, strOwner)
    iRow = 2
    Wscript.Echo vbTab & "Searching For: " & strValue
    Do Until iRow = 982
        Val = LCase(strValue)
        celltocheck = objWorksheet2.Cells(iRow, 1).Value
        iRow = iRow + 1
        If InStr(celltocheck, Val) Then
            Wscript.Echo vbTab & "Found: " & celltocheck & " Row (" & iRow & ")"
            objWorksheet2.Cells(iRow, 11).Value = strApp
            objWorksheet2.Cells(iRow, 12).Value = strOwner
            [b]Exit Loop[/b]
        End If
    Loop
End Function


Skip,
[sub]
[glasses]Just traded in my OLD subtlety...
for a NUance![tongue][/sub]
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top