Solved: Loop: IF Condition is getting skipped

[YellowLabPro]

In my code I want to loop through 5 columns, {Y, W, BC, BD, BE}, extract the data to another sheet if there are values present. But as it is written, if there is nothing in the middle column, col. BD, and a value in the last column, col. BE, the loop jumps out to the next i.
I have highlighted the two cells in yellow on the attached sheet.


Sub Attributes2()
Dim oWss As Worksheet, oWst As Worksheet, Aws As Worksheet
Dim i As Long, ii As Long, lLrws As Long, lLrwt As Long
Set oWss = ActiveSheet
Set oWst = Workbooks("TGSProductsAttrib.xls").Worksheets("ProductAttributes")
Set Aws = ActiveSheet
'Product ID#
ii = oWst.Cells(Rows.Count + 1).End(xlUp).Row
For i = 6 To LR(Aws, "BC")
If Not IsEmpty(Cells(i, "W").Value) Then
oWst.Cells(ii + 1, "A").Value = Cells(i, "W").Value
'Product Description
If Not IsEmpty(Cells(i, "Y").Value) Then
oWst.Cells(ii + 1, "B").Value = Cells(i, "Y").Value
'Trim 1
If Not IsEmpty(Cells(i, "BC").Value) Then
oWst.Cells(ii + 1, "C").Value = Cells(i, "BC").Value
'Trim 2
If Not IsEmpty(Cells(i, "BD").Value) Then
oWst.Cells(ii + 1, "D").Value = Cells(i, "BD").Value
'Trim 3
If Not IsEmpty(Cells(i, "BE").Value) Then
oWst.Cells(ii + 1, "E").Value = Cells(i, "BE").Value
ii = ii + 1
End If
End If
End If
End If
End If
Next i
End Sub

Function LR(Ws As Worksheet, Col As Variant) As Long
Application.Volatile
If Not IsNumeric(Col) Then Col = Columns(Col).Column()
LR = Ws.Cells(Rows.Count, Col).End(xlUp).Row
End Function

[SamT]

Have you tried using the full IF, Then, ElseIf structure?

[mdmackillop]

Hi Doug,
You skip because the If returns False. Just add the End If after each item, instead of nesting them

If Not IsEmpty(Cells(i, "W").Value) Then
oWst.Cells(ii + 1, "A").Value = Cells(i, "W").Value
End If

[mikerickson]

Would an And statment work rather than the nested If's? Or un-nested ifs?

Also, this may sounds silly, but why not just copy the cells without testing. If they are empty, you've copied nothing. (no change to the destination sheet) If there is something, you've copied it.

[mdmackillop]

Also, this may sounds silly, but why not just copy the cells without testing. If they are empty, you've copied nothing. (no change to the destination sheet) If there is something, you've copied it.
Agreed - unless you want to avoid overwriting cells containing data.

[YellowLabPro]

Thanks Malcolm,
Did not know I could do it that way.... greenhorn... you know.

Mike- that is an ok idea.... I did not think of it to tell you the truth.

[mikerickson]

Sinceii = oWst.Cells(Rows.Count + 1).End(xlUp).Row,writing to row ii+1 will never overwrite data.

[YellowLabPro]

Yes Mike that is correct,
This is to be a cumulative list.

[mdmackillop]

If Not IsEmpty(Cells(i, "W").Value) Then
oWst.Cells(ii + 1, "A").Value = Cells(i, "W").Value
So if W is empty, no value will be written to A, Values could be written to B-E.
On the next running, row ii will not be empty.

BTW
ii = oWst.Cells(Rows.Count + 1).End(xlUp).Row does not specify the column. It might be OK if you want to check A, but not good practice to rely on a default.

[YellowLabPro]

In this case, W and Y will always contain values. These are the product ID and product description of any newly entered record. The sheet initially is cleared out, so no values will exist in BD, BC, BE w/out values in W and Y.

[mdmackillop]

Hmmmmm
If Not IsEmpty(Cells(i, "W").Value) Then

[YellowLabPro]

Malcolm and Mike,
I think both of you were pointing out to me this line:



ii = oWst.Cells(Rows.Count + 1).End(xlUp).Row




I do have a problem w/ my logic, and don't know how to solve for it.
If none of the columns of {BC, BD, BE} have a value, then I do not want to copy the data over. But the way I have my code written, it does not evaluate for this, it copies over col. W and Y no matter what, and it should be dependent on whether there are values in one of the columns of a row from {BC, BD, BE}.

In my new upload attachment, I have removed the values in Row 16, but the code is going to still copy this record over. It should not.




Sub Attributes()


Dim oWss As Worksheet, oWst As Worksheet, oAws As Worksheet
Dim i As Long, ii As Long, lLrws As Long, lLrwt As Long
Set oWss = ActiveSheet
Set oWst = Workbooks("TGSProductsAttrib.xls").Worksheets("ProductAttributes")
Set oAws = ActiveSheet



'MsgBox LRs(oAws, "BC", 3)


oWst.Range("A1:E1").Value = Array("Product ID#", "Product Description", "Trim 1", "Trim 2", "Trim 3")
'Product ID#
ii = oWst.Cells(Rows.Count, "A").End(xlUp).Row + 1
For i = 6 To LRs(oAws, "BC", 3)
If Not IsEmpty(Cells(i, "W").Value) Then
oWst.Cells(ii, "A").Value = Cells(i, "W").Value
End If
'Product Description
If Not IsEmpty(Cells(i, "Y").Value) Then
oWst.Cells(ii, "B").Value = Cells(i, "Y").Value
End If
'Trim 1
If Not IsEmpty(Cells(i, "BC").Value) Then
oWst.Cells(ii, "C").Value = Cells(i, "BC").Value
End If
'Trim 2
If Not IsEmpty(Cells(i, "BD").Value) Then
oWst.Cells(ii, "D").Value = Cells(i, "BD").Value
End If
'Trim 3
If Not IsEmpty(Cells(i, "BE").Value) Then
oWst.Cells(ii, "E").Value = Cells(i, "BE").Value
End If
ii = ii + 1
Next i
End Sub

[mikerickson]

I think this logic will do what you want.
If Cells(i, "BC").Value = vbNullString _
And Cells(i, "BD").Value = vbNullString _
And Cells(i, "BE").Value = vbNullString Then

MsgBox "Copy nothing"
Else
MsgBox "Copy Data"
End If
I'm not sure if you want to test columns W and Y in the "Copy Data" case.

[malik641]

I do have a problem w/ my logic, and don't know how to solve for it.

If none of the columns of {BC, BD, BE} have a value, then I do not want to copy the data over. But the way I have my code written, it does not evaluate for this, it copies over col. W and Y no matter what, and it should be dependent on whether there are values in one of the columns of a row from {BC, BD, BE}.



Just to be sure:

IF *any* of the columns "BC", "BD", *or* "BE" have no value in it, do not copy over *any* column ("W", "Y", "BC", "BD", nor "BE") from the current row?

[YellowLabPro]

Hi Joseph,
Yes, you understand it correctly.

[YellowLabPro]

Here is my re-work of my program. Though I did not end up using your solution Mike, it did help me to re-think how I should go about this. Also the points you and Malcolm raised today were very helpful, again to look for potential problems.


Sub Attributes()
Dim oWss As Worksheet, oWst As Worksheet, oAws As Worksheet
Dim i As Long, ii As Long, lLrws As Long, lLrwt As Long
Set oWss = ActiveSheet
Set oWst = Workbooks("TGSProductsAttrib.xls").Worksheets("ProductAttributes")
Set oAws = ActiveSheet

'MsgBox LRs(oAws, "BC", 3)

oWst.Range("A1:E1").Value = Array("Product ID#", "Product Description", "Trim 1", "Trim 2", "Trim 3")
ii = oWst.Cells(Rows.Count, "A").End(xlUp).Row ' + 1
For i = 6 To LRs(oAws, "BC", 3)
If Not IsEmpty(Cells(i, "BC").Value) Or Not IsEmpty(Cells(i, "BD").Value) Or Not IsEmpty(Cells(i, "BE").Value) Then
ii = ii + 1
'Product Id#
oWst.Cells(ii, "A").Value = Cells(i, "W").Value
'Product Description
oWst.Cells(ii, "B").Value = Cells(i, "Y").Value
'Trim 1
oWst.Cells(ii, "C").Value = Cells(i, "BC").Value
'Trim 2
oWst.Cells(ii, "D").Value = Cells(i, "BD").Value
'Trim 3
oWst.Cells(ii, "E").Value = Cells(i, "BE").Value
End If
Next i
MsgBox "Done", , "Status"
End Sub

[mdmackillop]

A lot neater.
Rather than checking 3 cells, check the range in one step (resize)
Specify the Sheet using a With statement to make clear source sheet.
oWst.Range("A1:E1").Value = Array("Product ID#", "Product Description", "Trim 1", "Trim 2", "Trim 3")
ii = oWst.Cells(Rows.Count, "A").End(xlUp).Row ' + 1
With oAws
For i = 6 To LRs(oAws, "BC", 3)
If Application.CountA(.Cells(i, "BC").Resize(1, 3)) > 0 Then
ii = ii + 1
'Product Id#
oWst.Cells(ii, "A").Value = .Cells(i, "W").Value
'Product Description
oWst.Cells(ii, "B").Value = .Cells(i, "Y").Value
'Trim 1
oWst.Cells(ii, "C").Value = .Cells(i, "BC").Value
'Trim 2
oWst.Cells(ii, "D").Value = .Cells(i, "BD").Value
'Trim 3
oWst.Cells(ii, "E").Value = .Cells(i, "BE").Value
End If
Next i
End With
MsgBox "Done", , "Status"
End Sub

[YellowLabPro]

Thanks Malcolm-
That is sweeeeeeeet! But all my hardwork, no-one is ever going to believe I did anything now...