Solved

Modification Help .VBS Script excel 2003

Posted on 2009-05-08
39
2 solutions
294 Views
Last Modified: 2013-11-10
Hi all,

I have a script I need help modifying. Seems with this script if the column was empty in the results it was selecting the entire row any how so my work around was to use a case statement in sql and change the blank result to the word "Blank".  On Column O there are results that state the word "Blank". I need to find and delete the cell's value so its blank again and reposition me back to the top of the spreadsheet..  Can someone help me do this? I am kind of stuck thanks!

Call DoStuff
 
Sub DoStuff()
 
Set xlApp = CreateObject("Excel.Application")
Set xlWb = xlApp.Workbooks.Open("D:\NewMonthly\export\newplayers\newplayers.XLS")
Set xlWs = xlwb.Sheets("newplayers.XLS")   'amend as appropriate
 
with xlWs
  Set rngO = xlApp.Intersect(.UsedRange,.Range("O:O"))
  Set rngJ = xlApp.Intersect(.UsedRange,.Range("R:R"))
  Set rngH = xlApp.Intersect(.UsedRange,.Range("I:I"))
End With
 
For Each cell In rngO
  If cell<> Empty Then
    If InStr(cell, "Sourcecode")<1 Then 
       cell.EntireRow.Interior.ColorIndex = 2
       cell.EntireRow.Font.Bold = True
    End If
  End If
Next
 
For Each cell in rngJ
  If Isnumeric(cell) Then
    If cell>50000 Then 
       cell.EntireRow.Interior.ColorIndex = 17
       cell.EntireRow.Font.Bold = True
    Else
       cell.EntireRow.Interior.ColorIndex = -4142
       cell.EntireRow.Font.Bold = False
    End If
  Else
       cell.EntireRow.Interior.ColorIndex = -4142
       cell.EntireRow.Font.Bold = False   
  End If
Next
 
For Each cell In rngH
  If cell<>"" Then
    If Instr(cell,"##") Then
       cell.EntireRow.Interior.ColorIndex = 3
       cell.EntireRow.Font.Bold = True
                        '           Just the cell
                '       cell.Interior.ColorIndex = 6 
                        '      cell.Font.Bold = True
    End If
  End If
Next
 
For Each cell In rngO
  If cell<> "" Then
    If InStr(cell, "HSE")<1 And InStr(cell, "hse")<1 And InStr(cell, "JKT-")<1 And InStr(cell, "COP-")<1 And InStr(cell, "WATCH")<1 And InStr(cell, "86")<1 And InStr(cell, "sourcecode")<1 And InStr(cell, "Blank")<1 Then 
       cell.EntireRow.Interior.ColorIndex = 6
       cell.EntireRow.Font.Bold = True
    End If
  End If
Next
 
xlWb.Save
xlWb.close
 
xlApp.Quit
Set xlApp = Nothing
 
End Sub

Open in new window

0
Comment
Question by:smyers051972
[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
Join The Community
  • 20
  • 19
39 Comments
 
LVL 10

Expert Comment

by:cdebel
ID: 24339463
Can you try this line?
Make sure that the range cover up all your sheet...

Sheet1.Range("A1:IV65536").Replace "Blank", "", xlWhole
0
 
LVL 10

Expert Comment

by:cdebel
ID: 24339472
well, of course in your case you have to use wlWS and not Sheet1:
xlWs.Range("A1:IV65536").Replace "Blank", "", xlWhole
0
 
LVL 1

Author Comment

by:smyers051972
ID: 24339519
How about something like this even though I dont think the syntax is going to be right?
For Each cell In rngO
  If cell= "Blank" Then
    If InStr(cell, "HSE")>=1 Then 
      .Replace "Blank", "", xlWhole
  End If
Next

Open in new window

0
Independent Software Vendors: 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!

Take Survey Now!
 
LVL 1

Author Comment

by:smyers051972
ID: 24339526
forgot to change "HSE" oh well LOL
0
 
LVL 1

Author Comment

by:smyers051972
ID: 24339585
This did not work as posted below


For Each cell In rngO
  If cell= "Blank" Then
    If InStr(cell, "Blank")>=1 Then 
      .Replace "Blank", "", xlWhole End If
  End If
Next

Open in new window

0
 
LVL 10

Expert Comment

by:cdebel
ID: 24339643
Well, my solution replace the "Blank" in the whole sheet.  But if you prefer to do it only in column O...
Do this:
    rngO.Replace "Blank", "", xlWhole

There's no need to parse, cell by cell the cells of a range...
0
 
LVL 1

Author Comment

by:smyers051972
ID: 24339898
So something like this?


Call DoStuff
 
Sub DoStuff()
 
Set xlApp = CreateObject("Excel.Application")
Set xlWb = xlApp.Workbooks.Open("D:\NewMonthly\export\newplayers\newplayers.XLS")
Set xlWs = xlwb.Sheets("newplayers.XLS")   'amend as appropriate
 
with xlWs
  Set rngO = xlApp.Intersect(.UsedRange,.Range("O:O"))
  Set rngJ = xlApp.Intersect(.UsedRange,.Range("R:R"))
  Set rngH = xlApp.Intersect(.UsedRange,.Range("I:I"))
End With
 
For Each cell In rngO
  If cell<> Empty Then
    If InStr(cell, "Sourcecode")<1 Then 
       cell.EntireRow.Interior.ColorIndex = 2
       cell.EntireRow.Font.Bold = True
    End If
  End If
Next
 
For Each cell in rngJ
  If Isnumeric(cell) Then
    If cell>50000 Then 
       cell.EntireRow.Interior.ColorIndex = 17
       cell.EntireRow.Font.Bold = True
    Else
       cell.EntireRow.Interior.ColorIndex = -4142
       cell.EntireRow.Font.Bold = False
    End If
  Else
       cell.EntireRow.Interior.ColorIndex = -4142
       cell.EntireRow.Font.Bold = False   
  End If
Next
 
For Each cell In rngH
  If cell<>"" Then
    If Instr(cell,"##") Then
       cell.EntireRow.Interior.ColorIndex = 3
       cell.EntireRow.Font.Bold = True
		'	Just the cell
	    '	cell.Interior.ColorIndex = 6 
		'      cell.Font.Bold = True
    End If
  End If
Next
 
For Each cell In rngO
  If cell<> "" Then
    If InStr(cell, "HSE")<1 And InStr(cell, "hse")<1 And InStr(cell, "JKT-")<1 And InStr(cell, "COP-")<1 And InStr(cell, "WATCH")<1 And InStr(cell, "86")<1 And InStr(cell, "sourcecode")<1 And InStr(cell, "Blank")<1 Then 
       cell.EntireRow.Interior.ColorIndex = 6
       cell.EntireRow.Font.Bold = True
       rngO.Replace "Blank", "", xlWhole   ' INSERTED LINE HERE
    End If
  End If
Next
 
xlWb.Save
xlWb.close
 
xlApp.Quit
Set xlApp = Nothing
 
End Sub

Open in new window

0
 
LVL 10

Expert Comment

by:cdebel
ID: 24340056
Well, i would put it After (Outside) the For Each cell in rngO.  It just need to be done once...
0
 
LVL 10

Expert Comment

by:cdebel
ID: 24340059
like this:
For Each cell In rngO
  If cell<> "" Then
    If InStr(cell, "HSE")<1 And InStr(cell, "hse")<1 And InStr(cell, "JKT-")<1 And InStr(cell, "COP-")<1 And InStr(cell, "WATCH")<1 And InStr(cell, "86")<1 And InStr(cell, "sourcecode")<1 And InStr(cell, "Blank")<1 Then 
       cell.EntireRow.Interior.ColorIndex = 6
       cell.EntireRow.Font.Bold = True
    End If
  End If
Next
rngO.Replace "Blank", "", xlWhole   ' INSERTED LINE HERE

Open in new window

0
 
LVL 1

Author Comment

by:smyers051972
ID: 24340156
Ok when I tried it didnt work. I got the error shown here and updated code attached.


Call DoStuff
 
Sub DoStuff()
 
Set xlApp = CreateObject("Excel.Application")
Set xlWb = xlApp.Workbooks.Open("D:\NewMonthly\export\newplayers\newplayers.XLS")
Set xlWs = xlwb.Sheets("newplayers.XLS")   'amend as appropriate
 
with xlWs
  Set rngO = xlApp.Intersect(.UsedRange,.Range("O:O"))
  Set rngJ = xlApp.Intersect(.UsedRange,.Range("R:R"))
  Set rngH = xlApp.Intersect(.UsedRange,.Range("I:I"))
End With
 
For Each cell In rngO
  If cell<> Empty Then
    If InStr(cell, "Sourcecode")<1 Then 
       cell.EntireRow.Interior.ColorIndex = 2
       cell.EntireRow.Font.Bold = True
    End If
  End If
Next
 
For Each cell in rngJ
  If Isnumeric(cell) Then
    If cell>50000 Then 
       cell.EntireRow.Interior.ColorIndex = 17
       cell.EntireRow.Font.Bold = True
    Else
       cell.EntireRow.Interior.ColorIndex = -4142
       cell.EntireRow.Font.Bold = False
    End If
  Else
       cell.EntireRow.Interior.ColorIndex = -4142
       cell.EntireRow.Font.Bold = False   
  End If
Next
 
For Each cell In rngH
  If cell<>"" Then
    If Instr(cell,"##") Then
       cell.EntireRow.Interior.ColorIndex = 3
       cell.EntireRow.Font.Bold = True
		'	Just the cell
	    '	cell.Interior.ColorIndex = 6 
		'      cell.Font.Bold = True
    End If
  End If
Next
 
For Each cell In rngO
  If cell<> "" Then
    If InStr(cell, "HSE")<1 And InStr(cell, "hse")<1 And InStr(cell, "JKT-")<1 And InStr(cell, "COP-")<1 And InStr(cell, "WATCH")<1 And InStr(cell, "86")<1 And InStr(cell, "sourcecode")<1 And InStr(cell, "Blank")<1 Then 
       cell.EntireRow.Interior.ColorIndex = 6
       cell.EntireRow.Font.Bold = True
    End If
  End If
Next
rngO.Replace "Blank", "", xlWhole   ' INSERTED LINE HERE
 
xlWb.Save
xlWb.close
 
xlApp.Quit
Set xlApp = Nothing
 
End Sub

Open in new window

error1.bmp
0
 
LVL 10

Expert Comment

by:cdebel
ID: 24340238
strange... when i just do this on a blank workbook, it work just fine:

    Dim rgnO As Range
    Set rgnO = Application.Intersect(Sheet1.UsedRange, Sheet1.Range("O:O"))
    rgnO.Replace "Blank", "", xlWhole

Can you post your file?
0
 
LVL 1

Author Comment

by:smyers051972
ID: 24340253
Here you go
Call DoStuff
 
Sub DoStuff()
 
Set xlApp = CreateObject("Excel.Application")
Set xlWb = xlApp.Workbooks.Open("D:\NewMonthly\export\newplayers\newplayers.XLS")
Set xlWs = xlwb.Sheets("newplayers.XLS")   'amend as appropriate
 
with xlWs
  Set rngO = xlApp.Intersect(.UsedRange,.Range("O:O"))
  Set rngJ = xlApp.Intersect(.UsedRange,.Range("R:R"))
  Set rngH = xlApp.Intersect(.UsedRange,.Range("I:I"))
End With
 
For Each cell In rngO
  If cell<> Empty Then
    If InStr(cell, "Sourcecode")<1 Then 
       cell.EntireRow.Interior.ColorIndex = 2
       cell.EntireRow.Font.Bold = True
    End If
  End If
Next
 
For Each cell in rngJ
  If Isnumeric(cell) Then
    If cell>50000 Then 
       cell.EntireRow.Interior.ColorIndex = 17
       cell.EntireRow.Font.Bold = True
    Else
       cell.EntireRow.Interior.ColorIndex = -4142
       cell.EntireRow.Font.Bold = False
    End If
  Else
       cell.EntireRow.Interior.ColorIndex = -4142
       cell.EntireRow.Font.Bold = False   
  End If
Next
 
For Each cell In rngH
  If cell<>"" Then
    If Instr(cell,"##") Then
       cell.EntireRow.Interior.ColorIndex = 3
       cell.EntireRow.Font.Bold = True
		'	Just the cell
	    '	cell.Interior.ColorIndex = 6 
		'      cell.Font.Bold = True
    End If
  End If
Next
 
For Each cell In rngO
  If cell<> "" Then
    If InStr(cell, "HSE")<1 And InStr(cell, "hse")<1 And InStr(cell, "JKT-")<1 And InStr(cell, "COP-")<1 And InStr(cell, "WATCH")<1 And InStr(cell, "86")<1 And InStr(cell, "sourcecode")<1 And InStr(cell, "Blank")<1 Then 
       cell.EntireRow.Interior.ColorIndex = 6
       cell.EntireRow.Font.Bold = True
    End If
  End If
Next
rngO.Replace "Blank", "", xlWhole   ' INSERTED LINE HERE
 
xlWb.Save
xlWb.close
 
xlApp.Quit
Set xlApp = Nothing
 
End Sub

Open in new window

0
 
LVL 10

Expert Comment

by:cdebel
ID: 24340305
If you can't upload your file, try the solution of Smyers (the first one, not the last one since its the same as mine).

It's not efficient, but it should work.

All what my code is doing is to replace every occurence in a given range, in a single command.
Smyers is doing a replace, cell by cell...

My guess is that the Range is not properly set.   I would trace the code and check for rngO.Column, rngO.Row, rngO.Count to see if they make sense...

Note:
You should always put an Option Explicit declaration at the top of your VBA file.  This way it would force you to declare the variables and avoid any error such as mistyped variables (rgn vs rng).  But its not the case here.
0
 
LVL 1

Author Comment

by:smyers051972
ID: 24340320
This is a .VBS file I tend to avoid loading VBA in excel for automation purposes (through scripting)
0
 
LVL 10

Expert Comment

by:cdebel
ID: 24340378
Try your first method (doing a replace on each cell).  

I remember i had some troubles with range doing Automation with excel... just give me a min, i'll try to find my sample and i'll be back.
0
 
LVL 10

Expert Comment

by:cdebel
ID: 24340533
ok... now i remember!   You get this error because It doesn't recognize the xlWhole.

Usually you would write something like this when you try to do that thru automation:    
          Excel.XLLookAt.XLWhole

But for some reasons it doesn't work.  So just do this, outside of the loop as i specified in comment #24340059, but with 1 instead of xlWhole:
          rngO.Replace "Blank", "", 1
0
 
LVL 1

Author Comment

by:smyers051972
ID: 24340745
I think we're getting closer but still got this error attached below
error2.bmp
0
 
LVL 10

Expert Comment

by:cdebel
ID: 24340943
Ok.  Is there any "Blank" in your column O of your sheet?
If there's none, it give this error message.  It's quite annoying... so we should enclose this command between DisplayAlerts.  Like this:

xlApp.DisplayAlerts = false
n = rngO.Replace("Blank", "", 1)
xlApp.DisplayAlerts = true

But if you had "Blank" in any of your cell of column O, this is not normal...
0
 
LVL 1

Author Comment

by:smyers051972
ID: 24341170
Actually I populated the word Blank down the whole column where it was really an empty field. So yea theres many occurrences where that word is in there.  There is no quotes though.
0
 
LVL 10

Expert Comment

by:cdebel
ID: 24341375
Can you post this file please (your xls)?  Sorry to bother you with that, but i'm out of options.  
I've to put some trace in the VBS to figure out what's going on, but i need your test file to see where it goes wrong because with my test file, it work.
0
 
LVL 10

Accepted Solution

by:
cdebel earned 500 total points
ID: 24341526
Look at this file.  NewPlayers.xls is my test file.  Save it somewhere on your computer.
Then place the code below in a VBS file (in the same directory than NewPlayers.xls file).

There's only one little difference with your VBS file... mine try to find the XLS file in the same path than the VBS because of this:
Set fso = CreateObject("Scripting.FileSystemObject")
Set xlWb = xlApp.Workbooks.Open(fso.getabsolutepathname(".") & "\Newplayers.xls")

My files work... if you don't send me your NewPlayers.xls file, i think I'll never figure out what's happenning.
Call DoStuff
 
Sub DoStuff()
 
Set fso = CreateObject("Scripting.FileSystemObject")
Set xlApp = CreateObject("Excel.Application")
Set xlWb = xlApp.Workbooks.Open(fso.getabsolutepathname(".") & "\Newplayers.xls")
Set xlWs = xlwb.Sheets("Newplayers.xls")   'amend as appropriate
 
with xlWs
  Set rngO = xlApp.Intersect(.UsedRange,.Range("O:O"))
  Set rngJ = xlApp.Intersect(.UsedRange,.Range("R:R"))
  Set rngH = xlApp.Intersect(.UsedRange,.Range("I:I"))
End With
 
For Each cell In rngO
  If cell<> Empty Then
    If InStr(cell, "Sourcecode")<1 Then 
       cell.EntireRow.Interior.ColorIndex = 2
       cell.EntireRow.Font.Bold = True
    End If
  End If
Next
 
For Each cell in rngJ
  If Isnumeric(cell) Then
    If cell>50000 Then 
       cell.EntireRow.Interior.ColorIndex = 17
       cell.EntireRow.Font.Bold = True
    Else
       cell.EntireRow.Interior.ColorIndex = -4142
       cell.EntireRow.Font.Bold = False
    End If
  Else
       cell.EntireRow.Interior.ColorIndex = -4142
       cell.EntireRow.Font.Bold = False   
  End If
Next
 
For Each cell In rngH
  If cell<>"" Then
    If Instr(cell,"##") Then
       cell.EntireRow.Interior.ColorIndex = 3
       cell.EntireRow.Font.Bold = True
		'	Just the cell
	    '	cell.Interior.ColorIndex = 6 
		'      cell.Font.Bold = True
    End If
  End If
Next
 
For Each cell In rngO
  If cell<> "" Then
    If InStr(cell, "HSE")<1 And InStr(cell, "hse")<1 And InStr(cell, "JKT-")<1 And InStr(cell, "COP-")<1 And InStr(cell, "WATCH")<1 And InStr(cell, "86")<1 And InStr(cell, "sourcecode")<1 And InStr(cell, "Blank")<1 Then 
       cell.EntireRow.Interior.ColorIndex = 6
       cell.EntireRow.Font.Bold = True
    End If
  End If
Next
 
 
xlApp.DisplayAlerts = false
rngO.Replace "Blank", "", 1
xlApp.DisplayAlerts = true
 
xlWb.Save
xlWb.close
 
xlApp.Quit
Set xlApp = Nothing
 
End Sub

Open in new window

NewPlayers.xls
0
 
LVL 1

Author Comment

by:smyers051972
ID: 24341686
Hi I just got back sorry for the delay.  As for my file I cant because it has certain info in it. BUT reading your file it is a valid example.  I will be out of town till monday an will have to test then, can we meet back monday?
0
 
LVL 10

Expert Comment

by:cdebel
ID: 24341692
sure, i will be here.
0
 
LVL 1

Author Comment

by:smyers051972
ID: 24355937
testing now... will post results shortly...
0
 
LVL 1

Author Comment

by:smyers051972
ID: 24356343
Ok that one worked but curiously the word Blank is still in Column O i dont see a reference to delete those words in Column O ?
0
 
LVL 10

Expert Comment

by:cdebel
ID: 24356404
Have you tested with MY Excel file or YOUR file?
If you tested it with your file, can you test it with my file and tell me if it work?

The last version of the VBS that i posted is case sensitive.

So if you have "BLANK", "BLAnk" or anything else than "Blank", they won't be replaced by an empty string
0
 
LVL 1

Author Comment

by:smyers051972
ID: 24356430
I noticed its case sensitive, in my SQL query I have it populating Blank where they are blank so they would always be the same and no human would be putting those words into it. I simply did the case statement om SQL to populate that word for the script above.  If I didnt, the entire book was being processed every time :)
0
 
LVL 1

Author Comment

by:smyers051972
ID: 24356488
As for my file, it looks like your file was ok but mine wasnt, I was able to censor out information that shouldnt be allowed to the public domain here is a look at the file for you

1.newplayers.xls
0
 
LVL 10

Assisted Solution

by:cdebel
cdebel earned 500 total points
ID: 24356515
geeze.  Thanks for this file.  Only 1 second to look at your "Blank" cell was enough to let me see that there's a bunch of spaces after the word Blank.

Since my version is look at xlWhole, it was not working.

You can change that by modifying your replace to look for "Blank     " instead of "Blank".
Or, you could also change the "xlWhole" value (1) for "xlPart" if you are sure that no cells will contain the word "Blank" other than the cell that we are looking for.
0
 
LVL 1

Author Comment

by:smyers051972
ID: 24356550
Sorry I had to get permission, theres a lot of burocrisy here sometimes about uploading files, they actually copy everyones emails too so I wanted to CMA (Cover my ...) :)
0
 
LVL 1

Author Closing Comment

by:smyers051972
ID: 31579588
Thanks for your time AND patience :)
0
 
LVL 10

Expert Comment

by:cdebel
ID: 24356611
Its ok.  Anyway, you could do the solution i gave you at 24356515, but i think that we are just patching the problem.

If i were you, i would try to not do this trick in your SELECT query, and i would try to find why you get this problem (processing all the rows).
0
 
LVL 1

Author Comment

by:smyers051972
ID: 24356741
I am happy to do it that way, the problem I was running into was the "IF ITS NOT" part would also select all the rows that had an empty source code as well so the entire book [that had blank source codes] was yellow you could say :)
0
 
LVL 10

Expert Comment

by:cdebel
ID: 24356805
Yellow is ColorIndex 6 right?

So it only mean that your cells where not really blanked...
This line was not working properly: If cell<> "" Then

When you want to know if a cell is really empty, just take your sheet, double click into the cell, press HOME key on your keyboard to make sure you are at the beginning of the cell, and then press the END key on your keyboard.  If your cursor move, that's because it's not empty... there's probably some spaces or things like that.

Maybe just trying to do this would had solve your original problem:
If Trim(cell) <> "" then

:-)
0
 
LVL 10

Expert Comment

by:cdebel
ID: 24356810
Trim just remove trailing spaces at the beginning and the end of a string....
0
 
LVL 1

Author Comment

by:smyers051972
ID: 24357041
hmmm Thanks!

Will give it a try :)
0
 
LVL 1

Author Comment

by:smyers051972
ID: 24357060
I think what was happening is SQL was filling with spaces to the length of the data column.  Even though I did LTRIM(RTRIM( still filled with spaces...

ODD!
0
 
LVL 10

Expert Comment

by:cdebel
ID: 24357092
if it doesn't work in your SQL Query, i would do the trim in your VBS as i specified...

Anyway, there's some trails go follow if you want to really solve the problem.  I know that the solution work, but i consider it as a patch and i would lie if i was telling that i like that
0
 
LVL 1

Author Comment

by:smyers051972
ID: 24357103
Thanks a lot for your help and I will be trying it out just to see if it can be done the right way or not...
0

Featured Post

Independent Software Vendors: 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!

Take Survey Now!
Question has a verified solution.

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

Suggested Solutions
How to calculate Duration from text and number cell value
Article by: Shums
When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
Deleting Shapes - A Warning
Article by: Martin
This article describes a serious pitfall that can happen when deleting shapes using VBA.
Find Your Competitors' Best Backlinks Using Excel Pivot Tables
Video by: AnnieCushing
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
Xpdf - PDFfonts - Command Line Utility to List Fonts Used in a PDF File
Video by: Joe
In this seventh video of the Xpdf series, we discuss and demonstrate the PDFfonts utility, which lists all the fonts used in a PDF file. It does this via a command line interface, making it suitable for use in programs, scripts, batch files — any pl…
Advertise Here

751 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

Advertise Here