What's wrong with this loop in my code?

[5inco]

Hi!

I have this code:

---

Sub Copy()

Dim Row As Long, Col As Long

Set Dest = Sheets(3).Range("B" & Rows.Count).End(xlUp).Offset(1)
Sheets(1).Activate
Dim v As Variant
Z = Array("E", "D", "F")

For Row = 17 To Range("A" & Rows.Count).End(xlUp)
For Col = 0 To UBound(Z)
If Sheets(1).Cells(Row, Z(Col)) <> "" Then
Sheets(1).Cells(Row, Z(Col)).Copy Dest
Next Col
End If
Next Row


End Sub

---

It doesn't work. It doesn't do the loop. What am I doing wrong?

---

What I want the macro to do is this:

1. Start on row 17 Sheet1 and evaluate columns D, E, F
2. If cell on column E has code, it should copy it to first empty cell in column B on sheet2. If not, it should see if column D has code and do the same. If not, then it should go to cell in column F.
3. Do the same on each row with data on sheet1

I've managed to do some steps, but the loops don't work

Any help?

 

[Norie]

Perhaps.

Sub MyCopy()
Dim Dest As Range
Dim Rw As Long, Col As Long
Dim Z As Variant

    Set Dest = Sheets(3).Range("B" & Rows.Count).End(xlUp).Offset(1)

    Z = Array("E", "D", "F")

    With Sheets(1)
    
        For Rw = 17 To .Range("A" & Rows.Count).End(xlUp).Row
            For Col = LBound(Z) To UBound(Z)
                If .Cells(Rw, Z(Col)) <> "" Then
                    .Cells(Rw, Z(Col)).Copy Dest
                    Set Dest = Dest.Offset(1)
                End If
            Next Col
        Next Rw

    End With

End Sub

 

[5inco]

Hi, Norie!

That one was pretty close, but it doesn't copy the data in the correct order. For example:

Source data:

D E F

BLANK BLANK 4089
3533 475A 0201
0251 BLANK 4041
1579 9801 0770

Once I execute the code it retrieves this:

Column B

4089 (Correct)
475A (Correct)
3533 (Wrong - It should be 0251)
0201 (Wrong - It should be 9801)


So it's like if the code was evaluating every cell, because it goes to E17 and because it's blank, it goes to D17 and because it's blank, it goes to F17.
Then it goes to row 18 and because E18 has content, it copies it to Column B in Sheet3.
But then it goes wrongm because instead of evaluating row 19, it goes to D18 and because it has content, it copies it and then it goes to F19 and does the same. This is wrong.

You were really close to what I want, but doesn't do exactly what I need.

Thanks for trying

Perhaps.

Sub MyCopy()
Dim Dest As Range
Dim Rw As Long, Col As Long
Dim Z As Variant

    Set Dest = Sheets(3).Range("B" & Rows.Count).End(xlUp).Offset(1)

    Z = Array("E", "D", "F")

    With Sheets(1)
    
        For Rw = 17 To .Range("A" & Rows.Count).End(xlUp).Row
            For Col = LBound(Z) To UBound(Z)
                If .Cells(Rw, Z(Col)) <> "" Then
                    .Cells(Rw, Z(Col)).Copy Dest
                    Set Dest = Dest.Offset(1)
                End If
            Next Col
        Next Rw

    End With

End Sub

 

[Norie]

Why are you skipping rows?

If you go through the code logically the output should be this, I've included the blanks and columns for illustration.

BLANK	E
BLANK	D
4089	F
475A	E
3533	D
201	F
BLANK	E
251	D
4041	F
9801	E
1579	D
770	F

 

[5inco]

Ok! No That's not what it must do. It has to evaluate each row on these three columns in this way:

-The code must start on row 17 (Sheet(1)).
-Go to E17: - If it has content, copy it to Sheet(3)
- Only if it doesn't (if it's blank), then goes to D17
- In D17 the same happens: -If it has content, copy it to Sheet(3)
- Only if it doesn't (if it's blank), copies F17 on Sheet(3)

Then the same process must happen on rows 18, 19, etc

So as you see, copying depends on the first column (E). Only if this one has no content, then we proceed to the next column (D) and if this one doesn't have content, then we copy F. Only one of the three columns must be copied.

Sorry, if my code wasn't clear.

Thanks for your time and effort!! I really appreciate it

 

[Norie]

Do you mean you only want to copy the first non-blank cell in the column 'sequence' E, D, F of each row?

Option Explicit

Sub MyCopy()
Dim Dest As Range
Dim Rw As Long, Col As Long
Dim Z As Variant

    Set Dest = Sheets(3).Range("B" & Rows.Count).End(xlUp).Offset(1)

    Z = Array("E", "D", "F")

    With Sheets(1)
    
        For Rw = 17 To .Range("A" & Rows.Count).End(xlUp).Row
            For Col = LBound(Z) To UBound(Z)
                If .Cells(Rw, Z(Col)) <> "" Then
                    .Cells(Rw, Z(Col)).Copy Dest
                    Dest.Offset(, 1) = Z(Col)
                    Set Dest = Dest.Offset(1)
                    Exit For
                End If
            Next Col
        Next Rw

    End With

End Sub

 

[5inco]

Thanks, Norie! That was just what I was looking for. I've deleted the line Dest.Offset(,1) = Z(col) because it was writting on column C of Sheet(3) the column Letter.

If I only want to pastevalues what code should I add to the line:

.Cells(Rw, Z(Col)).Copy Dest

Nobody has been able to tell me this code. I've been working on it for a week. Thank you so much

Do you mean you only want to copy the first non-blank cell in the column 'sequence' E, D, F of each row?

Option Explicit

Sub MyCopy()
Dim Dest As Range
Dim Rw As Long, Col As Long
Dim Z As Variant

    Set Dest = Sheets(3).Range("B" & Rows.Count).End(xlUp).Offset(1)

    Z = Array("E", "D", "F")

    With Sheets(1)
    
        For Rw = 17 To .Range("A" & Rows.Count).End(xlUp).Row
            For Col = LBound(Z) To UBound(Z)
                If .Cells(Rw, Z(Col)) <> "" Then
                    .Cells(Rw, Z(Col)).Copy Dest
                    Dest.Offset(, 1) = Z(Col)
                    Set Dest = Dest.Offset(1)
                    Exit For
                End If
            Next Col
        Next Rw

    End With

End Sub

 

[Norie]

You could just do this.

  Dest.Value = .Cells(Rw, Z(Col)).Value

 

[5inco]

That's awesome!! Thank you so much for your expertise.

You could just do this.

  Dest.Value = .Cells(Rw, Z(Col)).Value

 

[mumps]

Try this:

Sub Test()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim rng As Range
    For Each rng In Sheets("Sheet1").Range("D2:D" & LastRow)
        If rng <> "" Then
            rng.Copy Sheets("Sheet2").Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)
        ElseIf rng = "" Then
            If rng.Offset(0, 1) <> "" Then
                rng.Offset(0, 1).Copy Sheets("Sheet2").Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)
            ElseIf rng.Offset(0, 1) = "" Then
                rng.Offset(0, 2).Copy Sheets("Sheet2").Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)
            End If
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub