Search excel sheet for string then update row value in two column

[bolobaboo]

Hi
I have never played with excel in VBS. This forum always gave me good idea and lots of help. Does anybody has any code i can use as guide ?
I have excel sheet. It has numerous columns and rows. But i have to search for string, once it found then update that rows in two column. I have string in text file in one column.
Thank you

 

[Remou]

A few notes:

Set xl=CreateObject("Excel.Application")
'Read-only is false
xl.Workbooks.Open "c:\Docs\LTD.xls",,False

Set r = xl.Range("A1:A15").Find("a")
If Not IsEmpty(r) Then
    r.Offset(0, 1) = r.Value
End If

'Pick one
xl.Visible=True
'xl.Quit

http://lessthandot.com

 

[bolobaboo]

Hi
Remou
Would you recommend correction om my code below ?

THX

Option Explicit
On Error Resume Next
Dim fs,objTextFile,newdate,newlocation,ctape
Dim strText0, arrStr,objExcel,objSpread,intRow
set fs=CreateObject("Scripting.FileSystemObject")
set objTextFile = fs.OpenTextFile("c:\anil\list.txt", ForReading)
' Open the Excel spreadsheet
Set objExcel = CreateObject("Excel.Application")
Set objSpread = objExcel.Workbooks.Open("c:\anil\filesystemlayoutfornbu.xls")
intRow = 2 'Row 1 often containes headings

newdate = inputbox ("New date for these tapes", "Enter New date ",".")
newlocation = inputbox ("New location for these tapes", "Enter New location for these Tapes ",".")

Do Until objTextFile.AtEndOfStream
arrStr = split(objTextFile.ReadLine,vbcrlf)
strText0 = arrStr(0)


' Here is the loop that cycles through the cells
Do Until objExcel.Cells(intRow, 1).Value = ""
sctape = objExcel.Cells(intRow, 1).Value
If InStr(sctape,strText0) Then

'How to replace (introw,3) cell value to newdate
'How to replace (introw,5) cell value to newlocation

End If
intRow = intRow + 1
Loop
Loop

'Clean Up
objTextFile.Close

set objTextFile = Nothing
objExcel.Quit
WScript.Quit
set fs = Nothing
wscript.quit

 

[Remou]

You should use TGML tages for code [ignore]

Your Code

[/ignore]

Option Explicit
'Do not use this line except for certain specific 
'reasons
'On Error Resume Next

Dim fs,objTextFile,newdate,newlocation,[red]s[/red]ctape
Dim strText0, arrStr,objExcel,objSpread,intRow

Set fs=CreateObject("Scripting.FileSystemObject")
'ForReading=1, you must use values
Set objTextFile = fs.OpenTextFile("c:\anil\list.txt", 1)
' Open the Excel spreadsheet
Set objExcel = CreateObject("Excel.Application")
Set objSpread = objExcel.Workbooks.Open("c:\anil\filesystemlayoutfornbu.xls")

'You should check rather than guessing
intRow = 2 'Row 1 often contains headings

newdate = inputbox ("New date for these tapes", "Enter New date ",".")
newlocation = inputbox ("New location for these tapes", "Enter New location for these Tapes ",".")

Do Until objTextFile.AtEndOfStream
   'What is going on here?
   'ReadLine reads until vbCrLf, so why split at
   'vbcrlf?
   arrStr = Split(objTextFile.ReadLine,vbcrlf)
   strText0 = arrStr(0)

   ' Here is the loop that cycles through the cells
   Do Until objExcel.Cells(intRow, 1).Value = ""
       sctape = objExcel.Cells(intRow, 1).Value
       If InStr(sctape,strText0) Then

           objExcel.Cells(intRow, 3) = newdate
           objExcel.Cells(intRow, 5) = newlocation
                      
       End If
       intRow = intRow + 1
    Loop
Loop

http://lessthandot.com

 

[bolobaboo]

Hi
Following is not looping from list.txt file ..

Do Until objTextFile.AtEndOfStream
.
.
.
loop

It only picks first entry , any idea ?

'What is going on here?
'ReadLine reads until vbCrLf, so why split at
'vbcrlf?
Here i am trying to read one line at a time then excute loop then go for next line.
Thank you.

 

[Remou]

Oops. Move :

intRow = 2 'Row 1 often contains headings


To after :

Do Until objTextFile.AtEndOfStream



There is no need to use split if there is nothing to split.

http://lessthandot.com

 

[bolobaboo]

It worked my purpose.
Thank you