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 DoStuffSub 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 appropriatewith 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 WithFor 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 IfNextFor 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 IfNextFor 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 IfNextFor 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 IfNextxlWb.SavexlWb.closexlApp.QuitSet xlApp = NothingEnd Sub
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 DoStuffSub 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 appropriatewith 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 WithFor 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 IfNextFor 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 IfNextFor 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 IfNextFor 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 IfNextxlApp.DisplayAlerts = falserngO.Replace "Blank", "", 1xlApp.DisplayAlerts = truexlWb.SavexlWb.closexlApp.QuitSet xlApp = NothingEnd Sub
well, of course in your case you have to use wlWS and not Sheet1:
xlWs.Range("A1:IV65536").Replace "Blank", "", xlWhole
0
There are many ways to learn to code these days. From coding bootcamps like Flatiron School to online courses to totally free beginner resources. The best way to learn to code depends on many factors, but the most important one is you. See what course is best for you.
Call DoStuffSub 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 appropriatewith 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 WithFor 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 IfNextFor 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 IfNextFor 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 IfNextFor 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 IfNextxlWb.SavexlWb.closexlApp.QuitSet xlApp = NothingEnd Sub
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 IfNextrngO.Replace "Blank", "", xlWhole ' INSERTED LINE HERE
Ok when I tried it didnt work. I got the error shown here and updated code attached.
Call DoStuffSub 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 appropriatewith 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 WithFor 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 IfNextFor 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 IfNextFor 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 IfNextFor 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 IfNextrngO.Replace "Blank", "", xlWhole ' INSERTED LINE HERExlWb.SavexlWb.closexlApp.QuitSet xlApp = NothingEnd Sub
Call DoStuffSub 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 appropriatewith 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 WithFor 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 IfNextFor 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 IfNextFor 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 IfNextFor 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 IfNextrngO.Replace "Blank", "", xlWhole ' INSERTED LINE HERExlWb.SavexlWb.closexlApp.QuitSet xlApp = NothingEnd Sub
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.
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
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:
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.
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.
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?
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 :)
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
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.
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 ...) :)
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 :)
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
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
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.Fi
Set xlWb = xlApp.Workbooks.Open(fso.g
My files work... if you don't send me your NewPlayers.xls file, i think I'll never figure out what's happenning.
Open in new window
NewPlayers.xls