Loop through data for copy to other sheets

[silvertyphoon1]

I’ve been working on some code that will basically pull data from one sheet to another based on certain criteria using loops. The code is causing me some headache if anyone can provide some support I would be greatly appreciative.

What I’m trying to do is listed in this sequence:

1. Press button that begins code to search sheet named “List” from the top of column B for the word “Complete” looping downward. If the word “Complete” is found it checks the current row column D for the word “Done”.

2. If both “Complete” and “Done” are found on the row in their respective columns the code will continue down searching for a row with only “Complete”.

3. Once the code finds a row with “Complete” only and nothing in the same row column D, the code will write certain information from the current row on sheet named “List” to a sheet named “Final”.

4. The data from sheet “List” column E of the current row will be copied to the “Final” sheet on the next available blank row column D, starting from row 4 moving down. The code will also copy from the current row of sheet “List” column G to “Final” sheet of that current row column E.

5. Last the code will write the word “Done” to the current row on the “List” sheet column D.

6. So when the button on my form is pressed it will repeat this code for each instance in which it finds the word “Complete” but “Done” is not found, then it will write the word done as mentioned above to make sure it is not repeated twice.

This is what I have so far but when I execute the code it’s only pulling some of the data that I need.


Any help would be great! Thanks in advance -

Sub checkComplete()
Dim destinationSheet As Worksheet
Dim oneCell As Range
Set destinationSheet = ThisWorkbook.Worksheets("Final")

With ThisWorkbook.Sheets("List").Range("B:B")
For Each oneCell In Range(.Cells(1,1),.Cells(.Rows.Count,1).End(xlUp))
With oneCell
If LCase(CStr(.Value)) = "complete" Then
With .Offset(0, 2)
If LCase(.Value) <> "done" Then
destinationSheet.Cells(Rows.Count,1).End(xlUp).Offset(1, 0).Resize(1, 1).Value = .EntireRow.Range("A1").Value

destinationSheet.Cells(Rows.Count,1).End(xlUp).Offset(0, 3).Resize(1, 1).Value = .EntireRow.Range("E1").Value

destinationSheet.Cells(Rows.Count,1).End(xlUp).Offset(0, 4).Resize(1, 1).Value = .EntireRow.Range("G1").Value

.Value = "Done"
End If
End With
End If
End With
Next oneCell
End With
End Sub