Copying rows based on cell value, not selecting next empty row on destination worksheet

user_19623351 0
Viewed 42

I have written a short VBA code to copy rows from one worksheet "Quote Tracker", to another sheet "Cashflow", once a certain value has been selected in Column "O" (75 - 100%).

The issue I am having is that the rows are not copied into the next available empty row, only further down the sheet. I am also unable to stop the code copying the same line multiple times.

Is there anything I can add to ensure they are always added to the top of the "Cashflow" sheet or next available row?

I am also unable to put anything together to detect duplicates, so if the code is run more than once, it just keeps adding them to the "Cashflow sheet". Can anything be added to stop this?

Here is what I have so far:

Sub MoveRowBasedOnCellValue()
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("Quote Tracker").UsedRange.Rows.Count
J = Worksheets("Cashflow").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Cashflow").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("Quote Tracker").Range("O1:O" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
    If CStr(xRg(K).Value) = "75 - 100%" Then
        xRg(K).EntireRow.Copy Destination:=Worksheets("Cashflow").Range("A" & J + 1)
        J = J + 1
    End If
Next
Application.ScreenUpdating = True
MsgBox "Jobs copied to Cashflow tab"
End Sub

If you require more information, please, just let me know. I'm new here and trying to make a good impression.

vba excel
1 Answers

I have compiled a sub that will suit your needs. The first issue I saw was your use of "On Error resume Next". This will make it nearly impossible to debug your code because the code will not tell you if there is an error it will simply skip over it. The second issue I was able to see was that you made the problem more complex than necessary. You used a For To loop where a For Each loop would get the job done more easily. I have added in a piece of code which makes the cell in the "P" column of the row with a value over 75% "Transferred" once it has been copied to the "Cashflow" sheet. The code also checks if "Transferred" is present in that column and if it is, it skips that value. Additionally, the code checks if J is 1 which would be the first value copied, and if it is not one then it adds one to the counter so that it does not paste on top of the row above.

Sub MoveRowBasedOnCellValue()

Dim QTWs As Worksheet
Dim CWs As Worksheet
    Set QTWs = Worksheets("Quote Tracker")
    Set CWs = Worksheets("Cashflow")
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = QTWs.UsedRange.Rows.Count
J = CWs.Cells(Rows.Count, "O").End(xlUp).Row
If J <> 1 Then
    J = J + 1
End If
Set xRg = QTWs.Range("O1:O" & I)
Application.ScreenUpdating = False
For Each c In xRg
K = c.Row
    If c.Value < 0.75 Then
        'Do Nothing
    Else
        If QTWs.Cells(K, 16) <> "Transferred" Then
            QTWs.Rows(K).Copy Destination:=Worksheets("Cashflow").Range("A" & J)
            QTWs.Cells(K, 16).Value = "Transferred"
            J = J + 1
        Else
        'Do Nothing
        End If
    End If
Next
Application.ScreenUpdating = True
MsgBox "Jobs copied to Cashflow tab"
End Sub

If you have questions about how it works, do not hesitate to let me know. Hope this helps!

user_194023490
Related