E=mc2
asked on
Working within an excel file using vbscript
I am using the following vbscript:
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.
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
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.
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
can be written better and in short as.Range("A7").Cut .Range("B2")
.Range("B7").Cut .Range("B5")
.Range("C7").Cut .Range("C5")
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)
Offset(1,0) is the cell below the found one, (,3) is 3 cells to the right, so starting with "A", it is "D".
ASKER
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.
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.
I've corrected the code snippet above, there was a copy'n'paste issue, so please review.
ASKER
Thanks, do you have a new code snippet or is the one you provided the corrected one?
ASKER
Qlemo - the code provided does not work.
Char 1 Subscript out of range..
Char 1 Subscript out of range..
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
which is more descriptive (you can do something similar for your file format constants).
ASKER
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)
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
if not cell is nothing then cell.Offset(1, 0).Value = cell.Offset(, 3)
ASKER
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?
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?
ASKER
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".
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".
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
For details about the Range.Find method, see http://msdn.microsoft.com/en-us/library/office/ff839746.aspx
ASKER
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.
const xlValues = -4163
Set cell = objXLWs.Range("A:A").Find(
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.
ASKER
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.
Also, please see my last comment at 08:36 and let me know your thoughts.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thanks. My apologies, perhaps next time I will start a new question for another request.
ASKER
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)
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(
if not cell is nothing then cell.Offset(0, 1).Value = cell.Offset(1, 3)
ASKER
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.
Set cell = Range("A:A").Find(0, , xlValues, xlWhole)
While Not cell Is Nothing
cell.EntireRow.Delete
Set cell = Range("A:A").FindNext(cell
Wend
Should I open a new question?
I get a type mismatch: 'Range' error.
Sorry, I forgot the dot (or objXLWs., your choice) before the Range.
Full syntax:
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
ASKER
Thanks however this still does not work:
I get an error which says:
Char 3
Object required: 'cell.Offset'
Code: 800A01A8
I get an error which says:
Char 3
Object required: 'cell.Offset'
Code: 800A01A8
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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 .