Solved

Modification Help .VBS Script excel 2003

Posted on 2009-05-08
39
285 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
  • 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
 
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
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 
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

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Whether you've completed a degree in computer sciences or you're a self-taught programmer, writing your first lines of code in the real world is always a challenge. Here are some of the most common pitfalls for new programmers.
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
Viewers will learn how to properly install Eclipse with the necessary JDK, and will take a look at an introductory Java program. Download Eclipse installation zip file: Extract files from zip file: Download and install JDK 8: Open Eclipse and …

705 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

Need Help in Real-Time?

Connect with top rated Experts

22 Experts available now in Live!

Get 1:1 Help Now