?
Solved

Working within an excel file using vbscript

Posted on 2013-11-21
22
Medium Priority
?
2,388 Views
Last Modified: 2013-11-22
I am using the following vbscript:
Dim objXLApp, objXLWb, objXLWs

Set objXLApp = CreateObject("Excel.Application")

objXLApp.Visible = True

Set objXLWb = objXLApp.Workbooks.Open("c:\scripts\workingfiles\converted.xls")

'~~> Working with Sheet1
Set objXLWs = objXLWb.Sheets(1)

With objXLWs
    .Columns("A:A").EntireColumn.Delete
    .Columns("D:D").EntireColumn.Delete
    .Columns("B:C").ColumnWidth = 24.57
    .Columns("D:D").ColumnWidth = 25.00
    .Columns("E:E").ColumnWidth = 25.00
    .Columns("F:F").ColumnWidth = 12.14
objXLWs.Range("A1").EntireRow.Insert
objXLWs.Range("A1").EntireRow.Insert
objXLWs.Range("A1").EntireRow.Insert
objXLWs.Range("A1").EntireRow.Insert
objXLWs.Range("A1").EntireRow.Insert
objXLWs.Range("A1").EntireRow.Insert
objXLWs.Cells(4, 2).Value = "START DATE"
objXLWs.Cells(4, 3).Value = "END DATE"

objXLWs.Cells(4, 2).Font.Bold = TRUE
objXLWs.Cells(4, 3).Font.Bold = TRUE


objXLWs.Columns("B:C").HorizontalAlignment = -4108
objXLWs.Columns("E").HorizontalAlignment = -4108


objXLWs.Range("A7").Cut
objXLWs.Range("B2").Select
objXLWs.Paste

objXLWs.Range("B7").Cut
objXLWs.Range("B5").Select
objXLWs.Paste

objXLWs.Range("C7").Cut
objXLWs.Range("C5").Select
objXLWs.Paste



End With

'~~> Save as Excel File (xls) to retain format
objXLWb.SaveAs "C:\Scripts\workingfiles\converted.xls", 56

'~~> File Formats
'51 = xlOpenXMLWorkbook (without macro's in 2007-2010, xlsx)
'52 = xlOpenXMLWorkbookMacroEnabled (with or without macro's in 2007-2010, xlsm)
'50 = xlExcel12 (Excel Binary Workbook in 2007-2010 with or without macro's, xlsb)
'56 = xlExcel8 (97-2003 format in Excel 2007-2010, xls)

objXLWb.Close (False)

Set objXLWs = Nothing
Set objXLWb = Nothing

objXLApp.Quit
Set objXLApp = Nothing

Open in new window

What I want to do is this:
If there is exists a specific data ie number or text in a specific field in Excel, then I want the contents of one field copied to the field to the right of the cell I am looking in.

For example:  If in Column A,  I find the data "1234567", then copy the text in column D and in the cell just below the one it found the "1234567", and copy it to the field just to the right of "1234567".

For instance say it finds in A8 the data 1234567, then it should look in D9, and copy the text from that field and copy it into field A9.
0
Comment
Question by:100questions
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 12
  • 8
22 Comments
 
LVL 1

Expert Comment

by:Dephault
ID: 39667377
If .Range("A8") = "1234567" then
    .Range("A9") = .Range("D9")
End if

Open in new window


Also when you use the With objXLWs keyword, anything between the 'With' & 'End With' you dont need to use objXLWs prefix. You just start with a .
0
 
LVL 70

Expert Comment

by:Qlemo
ID: 39667426
Because of the with,
objXLWs.Range("A7").Cut
objXLWs.Range("B2").Select
objXLWs.Paste

objXLWs.Range("B7").Cut
objXLWs.Range("B5").Select
objXLWs.Paste

objXLWs.Range("C7").Cut
objXLWs.Range("C5").Select
objXLWs.Paste

Open in new window

can be written better and in short as
.Range("A7").Cut .Range("B2")
.Range("B7").Cut .Range("B5")
.Range("C7").Cut .Range("C5")

Open in new window

0
 
LVL 70

Expert Comment

by:Qlemo
ID: 39667458
Coming back to the original request, you can perform a search. E.g. to search in "A" for "1234567" and set the value as requested:
Set cell = .Range("A:A").Find("1234567", , xlValues)
if not cell is nothing then cell.Offset(1, 0).Value = cell.Offset(, 3)

Open in new window

Offset(1,0) is the cell below the found one, (,3) is 3 cells to the right, so starting with "A", it is "D".
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:100questions
ID: 39667545
Thanks Qlemo.  I believe I will try this since what I need to do is look in column A and see if a specific value is found.  If yes, then I want to copy the Data from Column D, one row below where it found the data I was looking for.

I will advise if this works, since this is likely what I am looking for.  The other answers are good however they don't look in all the cells in column A.
0
 
LVL 70

Expert Comment

by:Qlemo
ID: 39667561
I've corrected the code snippet above, there was a copy'n'paste issue, so please review.
0
 

Author Comment

by:100questions
ID: 39668026
Thanks, do you have a new code snippet or is the one you provided the corrected one?
0
 

Author Comment

by:100questions
ID: 39668044
Qlemo - the code provided does not work.  
Char 1 Subscript out of range..
0
 
LVL 70

Expert Comment

by:Qlemo
ID: 39668333
The only potential issue I can see is the use of xlValues. Since VBS does not have access to that enum symbol, either replace that with the value -4163, or define a constant:
const xlValues = -4163

Open in new window

which is more descriptive (you can do something similar for your file format constants).
0
 

Author Comment

by:100questions
ID: 39668594
Thanks however now the script runs, however nothing happens.  

I have something like this inserted before the End With..

The value it's looking for is in column A, however it's preceded by a ', yet it does not take the value in column D (which is text), from the row below the data I am looking for.


const xlValues = -4163
Set cell = .Range("A:A").Find("123456", , xlValues)
if not cell is nothing then cell.Offset(1, 0).Value = cell.Offset(, 3)
0
 

Author Comment

by:100questions
ID: 39668624
Dephault - your option would not allow me to look inside all of column A.
Is there code you could provide which would allow me to look inside all of column A and hten if it finds '1234567', it should look at the next row down, and go to Column D, copy data found in that cell, to the right of where it found 1234567?
0
 

Author Comment

by:100questions
ID: 39668753
Qlemo - actually looking back at the spreadsheet I do notice a change.
The field just below "1234567" is now blank.  There used to be a 0 in that field but now it's blank.  So the script does make a change however I don't know why it's inserting a blank field just below "1234567".   There is data in the corresponding field in the D column, just below the "1234567", however it's not copying it into the field just to the right of "1234567".
0
 
LVL 70

Expert Comment

by:Qlemo
ID: 39668754
So you try to find exactly ",1234567", or is the value contained in a list in that cell (like "123,1234567,456", or what? We need a pattern we can find exactly, it might be contained or the whole cell's content. E.g. if we search for "1234567" in "123456789", we would have an hit here.
For details about the Range.Find method, see http://msdn.microsoft.com/en-us/library/office/ff839746.aspx
0
 

Author Comment

by:100questions
ID: 39668785
Qlemo - this worked for me to get what I want, a modifi

const xlValues = -4163
Set cell = objXLWs.Range("A:A").Find("1234567", , xlValues)
if not cell is nothing then cell.Offset(0, 1).Value = cell.Offset(1, 3)

Now I want to modify this further.  
Anytime it finds the number '0' in column A, delete the row altogether.
It has to be 0 on it's own though and not 0 within a number.
It can't delete a row that has 1230456 just because it has a zero.
0
 

Author Comment

by:100questions
ID: 39668831
Qlemo.  Yes I am trying to find exactly the number I specify in the Find.
Also, please see my last comment at 08:36 and let me know your thoughts.
0
 
LVL 70

Assisted Solution

by:Qlemo
Qlemo earned 2000 total points
ID: 39669108
The default search method of Find seems to be to search for partial strings, so we will have to adapt above:
const xlValues = -4163
const xlWhole = 1
Set cell = objXLWs.Range("A:A").Find("1234567", , xlValues, xlWhole)
if not cell is nothing then cell.Offset(0, 1).Value = cell.Offset(1, 3)

Open in new window

Second request (but keep in mind that you should not extend your question that way):
Set cell = Range("A:A").Find(0, , xlValues, xlWhole)
While Not cell Is Nothing
  cell.EntireRow.Delete
  Set cell = Range("A:A").FindNext(cell.Offset(-1, 0))
Wend

Open in new window

Since we are removing the active row, we have to go back one row again, and start from there, else we would skip the following row.
0
 

Author Comment

by:100questions
ID: 39669192
Thanks. My apologies, perhaps next time I will start a new question for another request.
0
 

Author Comment

by:100questions
ID: 39669272
Qlemo:

This works, I had to add a ' to the Find string since that's how the number shows up in my spreadsheet, preceded by a ':

const xlValues = -4163
const xlWhole = 1
Set cell = objXLWs.Range("A:A").Find("'1234567", , xlValues, xlWhole)
if not cell is nothing then cell.Offset(0, 1).Value = cell.Offset(1, 3)
0
 

Author Comment

by:100questions
ID: 39669697
This does not work:

Set cell = Range("A:A").Find(0, , xlValues, xlWhole)
While Not cell Is Nothing
  cell.EntireRow.Delete
  Set cell = Range("A:A").FindNext(cell.Offset(-1, 0))
Wend

Should I open a new question?

I get a type mismatch: 'Range' error.
0
 
LVL 70

Expert Comment

by:Qlemo
ID: 39669813
Sorry, I forgot the dot (or objXLWs., your choice) before the Range.
Full syntax:
Set cell = objXLWs.Range("A:A").Find(0, , xlValues, xlWhole)
While Not cell Is Nothing
  cell.EntireRow.Delete
  Set cell = objXLWs.Range("A:A").FindNext(cell.Offset(-1, 0))
Wend 

Open in new window

0
 

Author Comment

by:100questions
ID: 39670107
Thanks however this still does not work:

I get an error which says:  

Char 3
Object required: 'cell.Offset'
Code: 800A01A8
0
 
LVL 70

Accepted Solution

by:
Qlemo earned 2000 total points
ID: 39670673
Looking at my code: *facepalm*
Of course we can no longer access a cell of a row we just deleted :/ That is the part I did not check with my test sheet. Now it gets tricky:
Set cell = objXLWs.Range("A:A").Find(0, , xlValues, xlWhole)
While Not cell Is Nothing
  set cell=cell.Offset(1,0)  ' next row
  cell.Offset(-1,0).EntireRow.Delete 'delete found row
  Set cell = objXLWs.Range("A:A").FindNext(cell)
Wend 

Open in new window

0

Featured Post

Manage your data center from practically anywhere

The KN8164V features HD resolution of 1920 x 1200, FIPS 140-2 with level 1 security standards and virtual media transmissions at twice the speed. Built for reliability, the KN series provides local console and remote over IP access, ensuring 24/7 availability to all servers.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article shows how to use a free utility called 'Parkdale' to easily test the performance and benchmark any Hard Drive(s) installed in your computer. We also look at RAM Disks and their speed comparisons.
In this modest contribution, I want to share with the IT community (especially system administrators, IT Support Engineers and IT Help Desks) about Windows crashes/hangs and how to deal with these particular problems.
The viewer will learn how to successfully create a multiboot device using the SARDU utility on Windows 7. Start the SARDU utility: Change the image directory to wherever you store your ISOs, this will prevent you from having 2 copies of an ISO wit…
How to fix incompatible JVM issue while installing Eclipse While installing Eclipse in windows, got one error like above and unable to proceed with the installation. This video describes how to successfully install Eclipse. How to solve incompa…

765 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question