Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 324
  • Last Modified:

Modification Help .VBS Script excel 2003

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
smyers051972
Asked:
smyers051972
  • 20
  • 19
2 Solutions
 
Christian de BellefeuilleProgrammerCommented:
Can you try this line?
Make sure that the range cover up all your sheet...

Sheet1.Range("A1:IV65536").Replace "Blank", "", xlWhole
0
 
Christian de BellefeuilleProgrammerCommented:
well, of course in your case you have to use wlWS and not Sheet1:
xlWs.Range("A1:IV65536").Replace "Blank", "", xlWhole
0
 
smyers051972Author Commented:
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
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
smyers051972Author Commented:
forgot to change "HSE" oh well LOL
0
 
smyers051972Author Commented:
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
 
Christian de BellefeuilleProgrammerCommented:
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
 
smyers051972Author Commented:
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
 
Christian de BellefeuilleProgrammerCommented:
Well, i would put it After (Outside) the For Each cell in rngO.  It just need to be done once...
0
 
Christian de BellefeuilleProgrammerCommented:
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
 
smyers051972Author Commented:
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
 
Christian de BellefeuilleProgrammerCommented:
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
 
smyers051972Author Commented:
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
 
Christian de BellefeuilleProgrammerCommented:
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
 
smyers051972Author Commented:
This is a .VBS file I tend to avoid loading VBA in excel for automation purposes (through scripting)
0
 
Christian de BellefeuilleProgrammerCommented:
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
 
Christian de BellefeuilleProgrammerCommented:
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
 
smyers051972Author Commented:
I think we're getting closer but still got this error attached below
error2.bmp
0
 
Christian de BellefeuilleProgrammerCommented:
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
 
smyers051972Author Commented:
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
 
Christian de BellefeuilleProgrammerCommented:
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
 
Christian de BellefeuilleProgrammerCommented:
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
 
smyers051972Author Commented:
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
 
Christian de BellefeuilleProgrammerCommented:
sure, i will be here.
0
 
smyers051972Author Commented:
testing now... will post results shortly...
0
 
smyers051972Author Commented:
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
 
Christian de BellefeuilleProgrammerCommented:
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
 
smyers051972Author Commented:
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
 
smyers051972Author Commented:
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
 
Christian de BellefeuilleProgrammerCommented:
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
 
smyers051972Author Commented:
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
 
smyers051972Author Commented:
Thanks for your time AND patience :)
0
 
Christian de BellefeuilleProgrammerCommented:
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
 
smyers051972Author Commented:
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
 
Christian de BellefeuilleProgrammerCommented:
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
 
Christian de BellefeuilleProgrammerCommented:
Trim just remove trailing spaces at the beginning and the end of a string....
0
 
smyers051972Author Commented:
hmmm Thanks!

Will give it a try :)
0
 
smyers051972Author Commented:
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
 
Christian de BellefeuilleProgrammerCommented:
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
 
smyers051972Author Commented:
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

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

  • 20
  • 19
Tackle projects and never again get stuck behind a technical roadblock.
Join Now