Excel VBA: Detecting empty cell to end loop - vba

In Excel 2007 I have imported data consisting of a column of rows. I wish to set a VBA script to read through the data from top to bottom, using a loop. The loop should continue to iterate while the cell in the sixth column is not empty.
I have tried:
Do While IsEmpty(Cells(i,6)) = False
...
i = i + 1
Loop
...and also
Do While Cells(i, 6).Value <> ""
...
i = i + 1
Loop
The loop does what it is supposed to but an error ensues because the program goes on reading below the block of data. (I inserted "On Error GoTo Catch" in the loop, then after the loop "Catch: MsgBox Cells(i, 6).Value & "Error" so as to confirm that an error occurs).
There is nothing in the loop that would affect Cells(i,6).
There are many questions in Stack Overflow about empty cells but the answers tend to avoid the issue how to detect an empty cell to make a loop end. Is there a way of doing this?

Provided you're on the right sheet (replace below) the code you posted should work
i = 1
Do While sheets("sheet1").Cells(i, 6).Value <> ""
i = i + 1
Loop
Could you post a screenshot of the column end? Your error handling may be preventing the error message too, try disabling that temporarily. Do the columns all end on a certain row? You could specify "do while not blank AND row < end row".

Related

VBA How to Check if Cell Value is valid and exists?

I have this cell.Offset(0, -2) cell that I need to check if it exists inside my VBA loop.
My idea is that if the cell has an .Offset(0, -2) that does not exist (e.g. say cell = Column B and cell.Offset(0, -2) = Column A-1, cell.Offset(0, -2) is supposed to be invalid), I want to be able to check that it doesn't exist in the if else statement.
Right now when it doesn't exist, I'm getting a “Runtime Error 1004: Application defined or object defined error”.
I've tried IsErr(cell.Offset(0, -2)), cell.Offset(0, -2).Value, If cell.Offset(0, -2) Is Nothing Then, cell.Offset(0, -2) = "", but none of them seem to work... can anyone point me in the right direction? I'm pretty new to VBA and it seems like different variable types have different ways of checking if the value exists.
If you can use your offset amount as a variable, or some method to evaluate against the cell's column, you don't need to defend against errors. Consider below...
Sub IsvalidARea()
Dim OffsetAmount As Integer: OffsetAmount = -2
Dim Cell As Range
If Cell.Column + OffsetAmount < 1 Then
MsgBox "Oh FALSE!"
Else
'EVERYTHING IS OKAY!
End If
End Sub
A solution for this is by using the constantly misused On Error Resume Next, coupled with a If IsError. Here's an example:
On Error Resume Next
If IsError(ActiveCell.Offset(, -2).Select) = True Then
'This is indicative of an error. Meaning you are on Column B, and you ran out of space.
Else
'This means an error did not occur. Meaning you were at least on Column C or above.
End If
There may be a better solution, in fact I am sure there is. But what this will do is allow you to move past the actual 1004 Application error, and you can actually identify, and use the error that was really returned, instead of just forcing your macro/script to end.
To avoid using the error check, you can always check the current column index (B is 2) and make sure whatever you are offsetting by, once subtracted by your index is greater than 0. For example, column B is 2. Your offset is 2. 2 - 2 = 0, so it should not attempt it. Column C is 3, 3 - 2 = 1, which is greater than 0 so it would be valid. Both are explorable methods.

Excel VBA script filters header unexpectedly

Introduction
I have some spreadsheets like the following.
Here the header is on rows 16 and 17. There is a "header" to the left (not shown) among the earlier rows and columns that includes a picture, some non-tabular data, a legend, etc., that is unimportant here. Header text on row 16 is obfuscated because reasons. Data marked in bold red indicates that that sample point has undergone some process. Here is the code snippet from the script that highlights those data points in bold red.
' Traverse columns applying redding until hitting the row end, Comment, or SpGr: whichever comes first
For currIndex = abcDateCol + 1 To lastCol
' Check for exit conditions:
If Cells(abcDateRowDesc, currIndex).Value() = "Comments" Then Exit For
If Cells(abcDateRowDesc, currIndex).Value() <> "" Then
If Cells(abcDateRowDesc, currIndex + 1).Value() = "process" Then
' Looks like we have a column of something Red-able
Columns(ColumnLetter(currIndex) & ":" & ColumnLetter(currIndex + 1)).Select
Selection.AutoFilter ' Turn on autofiltering (hopefully)
Selection.AutoFilter Field:=2, Criteria1:="=1", Operator:=xlOr, Criteria2:="=e"
Selection.Font.ColorIndex = 3
Selection.Font.Bold = True
Selection.AutoFilter ' Turn off autofiltering
Columns(ColumnLetter(currIndex + 1) & ":" & ColumnLetter(currIndex + 1)).EntireColumn.Delete Shift:=xlToLeft
End If
End If
Next currIndex
Context
Here, abcDateCol refers to column AE, lastCol refers to column AQ, abcDateRow (not shown, but available) and abcDateRowDesc refer to the header rows 16 and 17 respectively, and the ColumnLetter function is a user-defined function that returns the human-readable column letter(s) given a column number; this is common functionality you may have seen elsewhere, or even made yourself.
Let's Continue
Never mind that the condition in If Cells(abcDateRowDesc, currIndex).Value() = "Comments" is never satisfied because of an oversight (I'm assuming) -- two different rows, guaranteed.
Let's take a look at what the spreadsheet looks like before this script is executed.
So, the script takes pairs of columns, and for each pair of columns it marks data cells bold red if a data cell's right-adjacent cell has a 1 (or an "e"?) (as a boolean; answers the question, "Has this sample point undergone whatever process?") and then trashes the "process" column.
The Problem
A client wants the gratuitous header gone, so they may more easily import the spreadsheet into whatever solution they have. Delete rows 1 through 15, and this is what I get.
What in the bleepity-bleep happened to the header? I don't understand how this first row gets highlighted. It seems too perfectly weird. Now, let's revisit the very first spreadsheet.
I've filled the "header" with some dummy text after the script executed. Wow, there's the first row reddened again, this time ad infinitum! So, this problem has always existed. Oh, and the first column, too! And, it magically stops right above the proper header so we would never see it.
The Questions
Why is this script unexpectedly reddening the first row and column? Can this be easily solved, or am I looking at some sort of a rewrite? If so, please point me in the general direction.
It helps to mention that these spreadsheets are generated from a Windows application and their scripts executed before a user has a copy of their spreadsheet. Also, regarding the second picture (the spreadsheet with the "process" columns shown), this spreadsheet is not something that normally exists. I generated it for the sake of this post by skipping the script's for loop. The application uses a chosen spreadsheet template, that looks the same minus the data, fills in the sample data, and then executes several scripts over the data.
I considered using conditional formatting, but there are a few dozen spreadsheet templates. Even if I just change the one I need, I can't change the fact that these common scripts run over it. I feel my best option is to correct the script. And, I wouldn't change the script to account for my edge case. The whole ecosystem feels flaky, but that's just subjective.
Note
I am not the author of this script (or any of my company's VBA!). I'm considering this an inheritance tax levied upon me.
*Update
I was asked if I traced through this code. I apologize that I didn't include that information in my original post. Here is what I know. Selection.Font.ColorIndex = 3 turns the cells in the selection that satisfy the autofilter plus the first row (two cells as only two columns are selected at a given time), and Selection.Font.Bold = True makes the same cells bold in the same manner. I suspect it has something to do with the autofilter, so I'm going to take a look at the answers now.
This edit should fix your problems, hopefully (they did for my remake of your spreadsheet, but we won't know til you try on the real thing)
' Traverse columns applying redding until hitting the row end, Comment, or SpGr: whichever comes first
For currIndex = abcDateCol + 1 To lastCol
' Check for exit conditions:
If Cells(abcDateRowDesc, currIndex).Value() = "Comments" Then Exit For
If Cells(abcDateRowDesc, currIndex).Value() <> "" Then
If Cells(abcDateRowDesc, currIndex + 1).Value() = "process" Then
' Looks like we have a column of something Red-able
'Columns(ColumnLetter(currIndex) & ":" & ColumnLetter(currIndex + 1)).Select
With Range(Cells(abcDateRowDesc, currIndex), Cells(abcDateRowDesc, currIndex + 1).End(xlDown))
.AutoFilter 2, "=1", xlOr, "=e"
' Don't format header
With .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) .Font.ColorIndex = 3
.Font.Bold = True
.AutoFilter ' Turn off autofiltering
End With
End With
Columns(currIndex + 1).Delete xlShiftLeft
End If
End If
Next currIndex
This all starts with a quirk of how the code is choosing its range to autofilter. The selected area is the full column, instead of the area you actually want to format (row 18 to the last entry). It seems that autofiltering on a full column with empty top rows automatically sets the first nonempty row as the header row. So the header is left unfiltered/unhidden by the statement, and it gets colored in as part of the full column selection. So that's why your headers are getting colored.
Now, if you tried to test this by putting data in the above empty rows like "a", those values would become the first ones in the column and would be selected as the headers - meaning those values get colored. Whatever is in the first nonempty row of your columns will be the autofilter header and will get colored.
But that should only affect the columns you explicitly colored, not the entirety of the first row, right? The problem here is that Excel likes to make assumptions about data in order to save time. So if you have a whole row full of red, bold "a"'s and right next to them you put in another "a" to test whether that cell is formatted or not... well, it automatically gives you a red, bold "a" despite the cell being previously unformatted! And if you keep going down the row in this way, it'll appear like your whole row got formatted. But, if you were to jump over a few columns (say, 5-ish) and enter in another "a", voila, it's unformatted, and any "a"s you put in near it will be too. You can also check what Excel by deleting an unformatted "a" in a far off column, then continuing to enter "a"'s all the way down until you reach that same cell - this time, the "a" will be red and bold because all of the others in the row were, too, even though we just checked that this was an unformatted cell!
Basically, having the wrong range for your autofilter made things act very unexpectedly, then trying to test the formatting issue by entering in values just made everything less clear. The code I've provided just autofilters the relevant area (row 17 to the last contiguous row), fixing the core issue.
here's a (commented) refactoring of your code that should do:
Option Explicit
Sub main()
Dim abcDateCol As Long, lastCol As Long, abcDateRow As Long, abcDateRowDesc As Long, currIndex As Long
abcDateCol = 31
lastCol = 43
abcDateRow = 16 '<--| you can change it to 1 for the last "scenario"
abcDateRowDesc = 17 '<--| you can change it to 2 for the last "scenario"
For currIndex = abcDateCol + 1 To lastCol '<--| loop through columns
With Cells(abcDateRow, currIndex) '<--| refer to cell in current column on row abcDateRow
If .Value = "Comments" Then Exit For '<--| Check for exit conditions on row 'abcDateRow'
If .Offset(1).Value <> "" And .Offset(1, 1).Value = "process" Then '<--| Check for processing conditions on row 'abcDateRowDesc'
With .Resize(.Offset(, 1).End(xlDown).Row - .Row + 1, 2) '<-- consider the range from current referenced cell 1 column to the right and down to last 'process' number/letter
.AutoFilter Field:=2, Criteria1:="=1", Operator:=xlOr, Criteria2:="=e" '<--| filter on "process" field with "1" or "e"
If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then '<--| if any values match...
With .Offset(2).Resize(.Rows.Count - 2, 1).SpecialCells(xlCellTypeVisible).Font '<--|... consider only filtered values skipping headers (2 rows), and apply formatting
.ColorIndex = 3
.Bold = True
End With
End If
.AutoFilter '<-- reset autofilter
.Resize(, 1).Offset(, 1).EntireColumn.Delete Shift:=xlToLeft '<-- delete the "2nd" column (i.e. one column offsetted to the right)
End With
End If
End With
Next currIndex
End Sub
there were two faults in your "inherited" code:
If Cells(abcDateRowDesc, currIndex).Value() = "Comments" Then Exit For was to be referred to abcDateRow index row instead
the formatting would be applied to all cells, were they filtered (matching) or not

Deleting rows with duplicate info in columns

I'm writing a code that copies data from one sheet into another and I've got that function working fine. Now, I'm trying to code it to delete any rows that contain duplicate information based off that information's ID number in column F. Part of our process is to manually enter in column E when each row has been worked.
So my end goal is for the code to delete rows where column E is blank and column F is a duplicate. My code runs, but doesn't delete anything. I'm really hoping I'm just missing something ridiculously obvious.
For i = 1 To Range("f" & Rows.Count).End(xlUp).Row
If Cells(i, 5).Value = "" Then 'if column E is blank on row i
x = Cells(i, 6).Value
If Not IsError(Application.Match(x, "F:F", 0)) Then '& if that row is a duplicate
ActiveSheet.Range(x).EntireRow.Delete 'delete new duplicate row
End If
End If
Next i
Try it with,
For i = Range("f" & Rows.Count).End(xlUp).Row to 1 Step -1
If Cells(i, 5).Value = "" Then 'if column E is blank on row i
x = Cells(i, 6).Value
If Application.Countif(Columns(6), x) > 1 Then '& if that row is a duplicate
Rows(i).EntireRow.Delete 'delete new duplicate row
End If
End If
Next i
You were trying to delete the row number x, not i. Additionally, everything was going to be matched once.
So there are a couple of errors that need to be addressed in your code. First, if you are looping over a range and deleting rows, it's best to start from the bottom and work your way up. This prevents issues where your iterator is on a row, that row gets deleted, and the loop essentially skips the next row.
Next, you are looking for a Match in column F of x, which contains a value from Column F. So, it will always return a value (itself, at the very minimum). Maybe try using a COUNTIF and seeing if it's greater than 1 may be a better option?
Next, you populated the variable x with the value in Cells(i, 6), but then you try to use it as a range when deleting. Change your code to the following and see if it works:
For i = Range("f" & Rows.Count).End(xlUp).Row To 1 Step -1
If Cells(i, 5).Value = "" Then 'if column E is blank on row i
x = Cells(i, 6).Value
If Application.Countif(Columns(6), x) > 1 Then '& if that row is a duplicate
ActiveSheet.Rows(i).Delete 'delete new duplicate row
End If
End If
Next i
Why not use the .RemoveDuplicates method? It's faster than looping around. Here's a rough outline on its use:
With Range
.RemoveDuplicates Columns:=Array(6), Header:=xlYes
End With
Here's the msdn doc for the method, and another page with a more detailed implementation. They should clear up any questions you might have.

If Error Then Blank

Thanks for taking a look at my question. Know that I am new to stackoverflow and VBA I have a long macro I've been working on. At one point in the macro I have to convert "Start Depth" (L) and "End Depth" (M) from "m" to "ft". Then I subtract the two to find the "Footage" (N). However, some of the values in the columns are originally left blank. So, after making my conversions and subtractions, I'm left with "#VALUE!" which is giving me errors later on in the macro. Originally I had changed all of the blanks to 0's before the conversions and subtractions. But, After "finishing" the macro I realize the zeros are messing with presenting the data. So, I'd like to just do the conversions and subtractions and then, change all the "#VALUES!" back to blanks. I found some stuff on this but nothing that I could (that i know of) use or specific to me:
http://www.ozgrid.com/forum/showthread.php?t=60740 and https://superuser.com/questions/715744/excel-2010-formula-how-do-i-write-this-formula-vba
Here is what i was using to change blanks into 0's
Worksheet1.Select
lastrow = Range("A666666").End(xlUp).Row
For Each cell In Range("A1:Q" & lastrow)
If Len(cell.Value) = 0 Then
cell.Value = 0
End If
Next
Here is the code resulting in errors. Note: The data starts with blanks and after using these formulas I am given errors because some of the original cells begin as null or blanks. Also, These lines aren't in this order but, they are the lines leaving errors.
ActiveCell.FormulaR1C1 = "=CONVERT(RC[2],""m"",""ft"")"
Selection.AutoFill Destination:=Range("N2:O2"), Type:=xlFillDefault
Selection.AutoFill Destination:=Range("N2:O" & lastrow)
Range("N1") = "Footage"
Range("N2").Select
ActiveCell.FormulaR1C1 = "=RC[-1]-RC[-2]"
Selection.AutoFill Destination:=Range("N2:N" & lastrow)
Any help is appreciated. Thanks guys!
It depends if the #VALUE! is being generated from a formula or from VBA code.
Formula
If it's being generated from a formula, wrap the formula in the IFERROR function. This was added in Excel 2007 I believe. So for example if your formula was:
=A1-B1
Then you could put
=IFERROR(A1-B1,"")
Which is saying, if A1-B1 is an error, return "", otherwise return the result of A1-B1.
VBA
If the value is being generated by VBA you could write a helper function that works like IFERROR
Public Function MyIfError(value As Variant, value_if_error As Variant)
If IsError(value) Then
MyIfError = value_if_error
Else
MyIfError = value
End If
End Function
And then pass your value through that.
This does not directly answer your question, but it does fix the presentation of Zero's on your worksheet. You can use the following setting to show Zeros as Blanks through VBA: ActiveWindow.DisplayZeros = False It might be a consideration instead of looping through everything looking for 0's and switching them to blanks manually.
Worksheet1.Select
lastrow = Range("A666666").End(xlUp).Row
For Each cell In Range("A1:Q" & lastrow)
If Len(cell.Value) = 0 Then
cell.Value = 0
End If
Next
For Each cell In Range("A1:Q" & lastrow)
cell.value = WorksheetFunction.Iferror(cell.value,"")
End If
Next
I'm sorry I don't have opprtunity to test it right but give it a try.
Bottom line is that I simply included a second loop that runs IFERROR function on your data.

VBA not handling "bad" characters when inserting values into spreadsheet

I'm using the following code to insert values from my result set into my spreadsheet:
Rst.MoveFirst
Do While Rst.EOF = False
For i = 0 To Rst.Fields.Count - 1
ActiveCell.Value = Rst.Fields(i).Value 'insert value into cell
ActiveCell.Offset(0, 1).Activate 'move to next cell for next value
Next i
ActiveCell.Offset(1, -i).Activate 'move to next row for next record
Rst.MoveNext
Loop
The problem I'm running into is that some users are using = as the first character in their input, and excel does not like that ("Application-defined or object-defined error").
I've seen the workaround for Entering '=' as the first character in a cell but I don't want to apply the ' to every field, ideally only if it starts with =.
I need a solution that also works with Null values. I've tried a bunch of different combinations (IsNull, IsDBNull), but I can't seem to find one that works.
I'm sitting on a Linux box right now so I can't test this but from memory...
If you set the Number format of the cell to "#" before you assign the value then that should mean that it takes values as literal strings
This also means that "0131" won't be changed to 131
ActiveCell.NumberFormat = "#" ' This Cell will hold text
ActiveCell.Value = Rst.Fields(i).Value 'insert value into cell
You could put the formating within an If Statement based on Rst.Fields(i).Type if you only want to do this for text fields
As #timwilliams suggested, I used this answer to set the format of the range (seems more efficient than #tompage's cell-by-cell approach) to text.